1

以下のように配列を展開する必要があります。答えを検索しましたが、以下のコードのように役立つものはないようです。

Sub MakeOneColumn()

Dim vaCells As Variant
Dim vOutput() As Variant
Dim i As Long, j As Long
Dim lRow As Long

If TypeName(Selection) = "Range" Then
    If Selection.Count > 1 Then
        If Selection.Count <= Selection.Parent.Rows.Count Then
            vaCells = Selection.Value

            ReDim vOutput(1 To UBound(vaCells, 1) * UBound(vaCells, 2), 1 To 1)

            For j = LBound(vaCells, 2) To UBound(vaCells, 2)
                For i = LBound(vaCells, 1) To UBound(vaCells, 1)
                    If Len(vaCells(i, j)) > 0 Then
                        lRow = lRow + 1
                        vOutput(lRow, 1) = vaCells(i, j)
                    End If
                Next i
                lRow = lRow + 1
            Next j

            Selection.ClearContents
            Selection.Cells(1).Resize(lRow).Value = vOutput
        End If
    End If
End If

End Sub

上記のコードは、行 "lRow = lRow+1"を追加しなくても機能します。ただし、配列の各列に空白行が必要です。行を追加すると、実行時エラー9、添え字が範囲外になります。

4

2 に答える 2

1

redimステートメントを以下に変更してください

  ReDim vOutput(1 To (UBound(vaCells, 1) * UBound(vaCells, 2)) + UBound(vaCells, 2), 1 To 1)
于 2013-03-11T01:40:43.937 に答える
0

lrowを2回繰り返しているため、エラーが発生します。1回はiループ内で1回はjループ内です。チェックすると、選択範囲内のすべてのセルに値がある場合にのみエラーが発生することがわかります。

lrow修正は、jループとiループの外側の初期値を設定し、現在のセルの値をに割り当てた後vOutputに繰り返します。次のようになります。

  lRow = 1
  For j = LBound(vaCells, 2) To UBound(vaCells, 2)
      For i = LBound(vaCells, 1) To UBound(vaCells, 1)
          If Len(vaCells(i, j)) > 0 Then
              vOutput(lRow, 1) = vaCells(i, j)
              lRow = lRow + 1
          End If
      Next i
  Next j

TypeNameちなみに、選択範囲は常にRangeタイプであるため、テストは必要ありません。

于 2013-03-11T01:25:19.090 に答える