Excel VBA代码，用于将三行数据合并到一行中

我有所有卡号的访问数据。每个卡号有三行三个条目。但我想把每个卡号的数据放在一行

我尝试了下面的代码，但输出有2行空白。

请您建议其他解决方案，以便为每个卡号在一行中获得正确的数据

Sub ConsolidateData()

    For i = 2 To 19
    
    'for first row
    Sheet3.Range("A" & i) = Sheet2.Range("A" & i)
    Sheet3.Range("B" & i) = Sheet2.Range("B" & i)
    Sheet3.Range("C" & i) = Sheet2.Range("C" & i)
    Sheet3.Range("D" & i) = Sheet2.Range("D" & i)
    
    'for second row
    i = i + 1
    Sheet3.Range("E" & i - 1) = Sheet2.Range("B" & i)
    Sheet3.Range("F" & i - 1) = Sheet2.Range("C" & i)
    Sheet3.Range("G" & i - 1) = Sheet2.Range("D" & i)
    
    'for 3rd row
    i = i + 1
    Sheet3.Range("H" & i - 2) = Sheet2.Range("B" & i)
    Sheet3.Range("I" & i - 2) = Sheet2.Range("C" & i)
    Sheet3.Range("J" & i - 2) = Sheet2.Range("D" & i)
    Next i


End Sub

---

请尝试下一个代码。它使用数组，速度非常快（在内存中工作），并返回下一页最后一行“A2:J”范围内的处理结果。它可以返回您需要的任何位置：

Sub extractCardData()
   Dim sh As Worksheet, sh3 As Worksheet, lastR As Long, arr, arrFin, i As Long, k As Long
   
   Set sh = ActiveSheet 'use here your necessary sheet (Sheet2)
   Set sh3 = sh.Next    'the following sheet. Use here your Sheet3, if not the next...
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
   arr = sh.Range("A2:D" & lastR).value
   ReDim arrFin(1 To UBound(arr) / 3, 1 To 10) 'redim the array to keep the processing result
   For i = 1 To UBound(arr) Step 3                 'iterate between the array elemts from 3 to 3
        k = k + 1                                          'increment the array row
        'put the values in the array columns
        arrFin(k, 1) = arr(i, 1): arrFin(k, 2) = arr(i, 2): arrFin(k, 3) = arr(i, 3): arrFin(k, 4) = arr(i, 4)
        arrFin(k, 5) = arr(i + 1, 2): arrFin(k, 6) = arr(i + 1, 3): arrFin(k, 7) = arr(i + 1, 4)
        arrFin(k, 8) = arr(i + 2, 2): arrFin(k, 9) = arr(i + 2, 3): arrFin(k, 10) = arr(i + 2, 4)
   Next i
   'drop the arrFin content, at once:
   sh3.Range("A2").Resize(UBound(arrFin), 10).value = arrFin
   'format the columns keeping hours:minutes:
   Union(sh3.Range("C2:C" & 2 + UBound(arrFin)), sh3.Range("F2:F" & 2 + UBound(arrFin)), sh3.Range("I2:I" & 2 + UBound(arrFin))).NumberFormat = "hh:mm"
End Sub

---

您还可以使用Windows Excel 2010+和Office 365 Excel中提供的

电源查询

，获得所需的输出

• 在原始表格中选择一些单元格

• Data=>Get&Transform=>fromtable/Range

• 当PQ UI打开时，导航到

  Home=>Advanced Editor

• 记下代码第2行中的表名
• 将现有代码替换为下面的M代码
• 将粘贴代码第2行中的表名更改为“真实”表名
• 检查所有注释，以及

  应用步骤

  窗口，以便更好地理解算法和步骤

M代码

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Card number", Int64.Type}, {"Date", type date}, {"Time", Time.Type}, {"Action", type text}}),

//Unpivot other than the CardNumber so as to have a separate row for each attribute and cardNumber
#"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Card number"}, "Attribute", "Value"),

//Create our new column headers
    #"Added Index" = Table.AddIndexColumn(#"Unpivoted Other Columns", "Index", 0, 1, Int64.Type),
    #"Added Custom" = Table.AddColumn(#"Added Index", "colHeaders", 
        each [Attribute] & Text.From(Number.Mod(Number.IntegerDivide([Index],3),3)+1)),

//Remove unneeded columns
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"Index", "Attribute"}),

//Pivot on the created column headers column
    #"Pivoted Column" = Table.Pivot(#"Removed Columns", List.Distinct(#"Removed Columns"[colHeaders]), "colHeaders", "Value"),

//Sort back to the original row order
//This line is optional
    #"Sorted Rows" = Table.Sort(#"Pivoted Column",{each List.PositionOf(List.Distinct(Source[Card number]),[Card number])}  )
in
    #"Sorted Rows"

---

因此，要处理的数据总是包含在三个连续的行中。这种理解正确吗？如果我以上问题的答案是肯定的，请测试我发布的代码并发送一些反馈。是的，要处理的数据总是包含在连续的三行中。谢谢你的代码工作得很好！