1

次の形式で Excel にインポートされたプログラムから出力を取得します。

Item 1  
1       10
2       10
3       20
5       20
8       30
13      30
Item 2  
1       40
2       40
3       50
5       50
8       60
13      60
Item 3  
1       50
2       50
3       40
5       40
8       30
13      30

ここで、以下のように、各項目の値が隣り合わせに配置されるテーブルを作成したいと思います。

        Item 1      Item 2      Item 3
1       10          40          50
2       10          40          50
3       20          50          40
5       20          50          40
8       30          60          30
13      30          60          30

他の関数を組み合わせた式を使用してこれを行う方法を考えることができますが、INDIRECTすぐにそれが非常に面倒であることがわかります。これを行う賢い方法はありますか?

私のアプローチは次のようになります。

=VLOOKUP($A6;indirect("A"&(6+G$5*$X$4):"D"&(30+G$5*$X$4));4;FALSE)

最初のルックアップ テーブルは からA6:D30、2 番目は からA32:D56です。各アイテムの行数であるX4値を含み、です。これをリストの横に配置し、横方向と下方向にドラッグします。手順はうまくいくと思いますが、構文エラーが発生します。26G5:AA50, 1, 2 ...Item 1

VBA を書いた経験はあまりありませんが、読んで理解することはできます。

アップデート:

シッダールスの要請で:

ここに画像の説明を入力

4

3 に答える 3

0

これは私が試したものです。

シート 1 にはデータが含まれています。結果はシート 2 に生成されます

サブ createTable()

Dim counter As Integer
Dim countRow As Integer
Dim flag As Boolean
Dim cellAddress As String
flag = True
countRow = 2
counter = 2

ThisWorkbook.Sheets("Sheet1").Activate

For Each cell In Range("a:a")
If counter = 2 Then
    If InStr(1, cell.Value, "Item") Then
        ThisWorkbook.Sheets("Sheet2").Activate
        ActiveSheet.Cells(1, counter).Value = cell.Value
        firstItem = cell.Value
        counter = counter + 1

     End If
Else
         ThisWorkbook.Sheets("Sheet2").Activate
          If InStr(1, cell.Value, "Item") Then
        ThisWorkbook.Sheets("Sheet2").Activate
        ActiveSheet.Cells(1, counter).Value = cell.Value
        counter = counter + 1
        flag = False
         End If
         If flag = True Then
         Cells(cell.Row, cell.Column) = cell.Value
         End If

End If
If cell.Value = vbNullString Then
Exit For
End If
Next cell

ThisWorkbook.Sheets("Sheet1").Activate

Application.CutCopyMode = False

Dim counteradd As Integer
counteradd = 2
For Each cell In Range("a:a")
    v = cell.Value
    If InStr(1, cell.Value, "Item") Then
        If cell.Offset(1, 1).Select <> vbNullString Then
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets("Sheet2").Select
            Cells(2, counteradd).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            counteradd = counteradd + 1
            ThisWorkbook.Sheets("Sheet1").Activate
        End If
    End If
Next cell

サブ終了

于 2013-10-21T14:36:28.480 に答える