在Excel中从导入列表中创build表格

我从以下列格式导入到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 

现在，我想创build一个表格，每个项目的值如下所示：

  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其他function组合的公式来做到这一点，但是我可以马上看到，这将是一个巨大的痛苦。 有没有一个聪明的方法来做到这一点？

我的做法是这样的：

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

我的第一个查找表是从A6:D30 ，第二个从A32:D56 。 X4包含值26 ，它是每个项目的行数， G5:AA5是0, 1, 2 ... 除了Item 1列表之外，我会放置它，并将其向侧面和向下拖动。 我认为该过程应该工作，但我得到语法错误。

我没有太多编写VBA的经验，但我有能力阅读和理解它。

更新：

在悉达思的要求下：

Answer 1

你可以看看这个。
它假定一个固定的格式，如你的例子所示。
它可以做成dynamic的，但是你需要自定义代码。

 Option Explicit Sub test() Dim oCollection As Collection Dim oDict As Variant Dim oItem As Object Dim iCnt As Integer Dim iCnt_B As Integer Dim iCnt_items As Integer Dim iCnt_records As Integer Dim iID As Integer Dim iValue As Integer Dim strKey As Variant 'Nr of items iCnt_items = 3 'Records per item iCnt_records = 6 'This dictionary will store the items Set oCollection = New Collection 'Store dictionaries in collection For iCnt = 0 To iCnt_items - 1 Set oDict = CreateObject("Scripting.Dictionary") For iCnt_B = 1 To iCnt_records iID = ThisWorkbook.Sheets(1).Cells((iCnt * (iCnt_records) + (iCnt + 1) + iCnt_B), 1).Value Debug.Print iID iValue = ThisWorkbook.Sheets(1).Cells((iCnt * (iCnt_records) + (iCnt + 1) + iCnt_B), 2).Value Debug.Print iValue oDict.Add iID, iValue Next iCnt_B oCollection.Add oDict, "item " & iCnt Next iCnt 'Write collection to sheet iCnt = 0 For Each oItem In oCollection iCnt = iCnt + 1 ThisWorkbook.Sheets(2).Cells(1, 1 + iCnt).Value = "item " & iCnt iCnt_B = 0 For Each strKey In oItem.keys iCnt_B = iCnt_B + 1 ThisWorkbook.Sheets(2).Cells(1 + iCnt_B, 1).Value = strKey ThisWorkbook.Sheets(2).Cells(1 + iCnt_B, 1 + iCnt).Value = oItem(strKey) Next Next oItem End Sub 

编辑：对话中断对不起 – >编程时，我没有跟进评论部分。

边注：

如果你使用的范围是dynamic的，我会用字典去。
我之所以说这是因为字典对象在其logging上使用索引。
密钥对结构是：ID，值
允许您直接访问与给定ID相对应的值。
在你的例子中，你正在使用一个清晰​​的ID值结构。
使用数字ID实际上是最快的。

Answer 2

由于我已经在这方面做了…这是另一种方式..

假设：

1. 数据从Sheet1中第5行开始
2. 输出将在Sheet2中生成

码：

下面的代码使用Collections和Formulas来实现你想要的。

 Sub Sample() Dim wsInput As Worksheet, wsOutput As Worksheet Dim ColItems As New Collection, ColSubItems As New Collection Dim lRow As Long, i As Long, N As Long Dim itm Set wsInput = ThisWorkbook.Sheets("Sheet1") Set wsOutput = ThisWorkbook.Sheets("Sheet2") With wsInput lRow = .Range("B" & .Rows.Count).End(xlUp).Row .Columns(1).Insert .Range("A5:A" & lRow).Formula = "=IF(ISERROR(SEARCH(""Item"",B5,1)),A4,B5)" For i = 5 To lRow On Error Resume Next If InStr(1, .Range("B" & i).Value, "item", vbTextCompare) Then ColItems.Add .Range("B" & i).Value, CStr(.Range("B" & i).Value) Else ColSubItems.Add .Range("B" & i).Value, CStr(.Range("B" & i).Value) End If On Error GoTo 0 Next i End With With wsOutput .Cells.ClearContents N = 2 '~~> Create Header in Row 1 For Each itm In ColItems .Cells(1, N).Value = itm N = N + 1 Next N = 2 '~~> Create headers in Col 1 For Each itm In ColSubItems .Cells(N, 1).Value = itm N = N + 1 Next lRow = .Range("A" & .Rows.Count).End(xlUp).Row lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column j = 2 For i = 2 To lcol .Range(.Cells(j, i), .Cells(lRow, i)).Formula = "=SUMIFS(" & _ wsInput.Name & _ "!C:C," & wsInput.Name & _ "!A:A," & .Name & _ "!$" & _ Split(.Cells(, i).Address, "$")(1) & _ "$1," & _ wsInput.Name & _ "!B:B," & _ .Name & _ "!A:A)" Next i .Rows("1:" & lRow).Value = .Rows("1:" & lRow).Value End With wsInput.Columns(1).Delete End Sub 

截图：

Answer 3

这是我所尝试过的。

工作表1包含数据。 结果在Sheet 2中生成

Sub 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 

结束小组