复制相似的值的数据

我有一个包含发票号码和明细号码的电子表格。 详细数字指向信息所在发票上的行。 在一个电子表格上可以有多个发票，但不幸的是，只有一个发票和详细信息组合在一行上。 因此，我的电子表格中的第1行将包含A列中的单个发票和B列中的详细信息，然后下一个发票开始第2行。我的问题是我想创build一个程序，它将查找任何重复的发票并复制并粘贴关联的细节数字到一个单一的行，以便我将最终：

InvoiceA. Detail1. Detail2. Detail3. Etc InvoiceB. Detail1. Detail2. Etc 

而不是：

 InvoiceA. Detail InvoiceA. Detail InvoiceB. Detail InvoiceB. Detail 

我曾经想过使用带发票的先进filter的macros来浏览每个单元格 – 对可见行进行计数并将详细信息复制到电子表格中的指定位置，然后使用一个明细数字删除额外的发票号码。 但是，这似乎效率低下。

以下是我目前所熟悉的

 Sub detail() Dim wb As Workbook, ws As Worksheet Dim dtl1 As Range, dtl2 As Range, dtl3 As Range, dtl4 As Range, dtl5 As Range, dtl6 As Range Set wb = ThisWorkbook Set ws = wb.Sheets("Sheet1") lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row Set inv = ws.Range("D2:D" & lastRow) Set dtl1 = ws.Range("E2:E" & lastRow) ' 'ws.Range("E:I").EntireColumn.Insert 'With ws '.Range("E1").Value = "Detail 2" '.Range("F1").Value = "Detail 3" '.Range("G1").Value = "Detail 4" '.Range("H1").Value = "Detail 5" '.Range("I1").Value = "Detail 6" 'End With For i = 1 To ws.Rows.Count If inv.Cells(i, 1).Value = "" Then Exit Sub End If If inv.Cells(i, 1) = inv.Cells(i, 1).Offset(-1, 0) And dtl1.Cells(i, 1).Offset(-1, 1) = "" Then dtl1.Cells(i, 1).Copy dtl1.Cells(i, 1).Offset(-1, 1).PasteSpecial If inv.Cells(i, 1) = inv.Cells(i, 1).Offset(-2, 0) And dtl1.Cells(i, 1).Offset(-2, 2) = "" Then dtl1.Cells(i, 1).Copy dtl1.Cells(i, 1).Offset(-2, 2).PasteSpecial If inv.Cells(i, 1) = inv.Cells(i, 1).Offset(-3, 0) And dtl1.Cells(i, 1).Offset(-3, 3) = "" Then dtl1.Cells(i, 1).Copy dtl1.Cells(i, 1).Offset(-3, 3).PasteSpecial If inv.Cells(i, 1) = inv.Cells(i, 1).Offset(-4, 0) And dtl1.Cells(i, 1).Offset(-4, 4) = "" Then dtl1.Cells(i, 1).Copy dtl1.Cells(i, 1).Offset(-4, 4).PasteSpecial If inv.Cells(i, 1) = inv.Cells(i, 1).Offset(-5, 0) And dtl1.Cells(i, 1).Offset(-5, 5) = "" Then dtl1.Cells(i, 1).Copy dtl1.Cells(i, 1).Offset(-5, 5).PasteSpecial If inv.Cells(i, 1) = inv.Cells(i, 1).Offset(-6, 0) And dtl1.Cells(i, 1).Offset(-6, 6) = "" Then dtl1.Cells(i, 1).Copy dtl1.Cells(i, 1).Offset(-6, 6).PasteSpecial End If End If End If End If End If End If Next i End Sub 

Answer 1

试试这个macros。 它创build一个按行分组发票的新工作表。 它假设数据是在第二行开始的工作表（“发票”）列A和B. 请调整这些参数，以你的胜利。

 Sub CreateGroupedInvoiceSheet() Application.screenUpdating = False Dim src As Range: Set src = Sheets("Invoice").Range("A2") Dim dest As Range: Set dest = Sheets.Add.Range("A2") Dim lastR As Long: lastR = Sheets("Invoice").Range("A" & Rows.count).End(xlUp).Row Dim curInvoice As Variant Do Until src.Row > lastR curInvoice = src.Value src.Resize(1, 2).Copy dest Set dest = dest.Offset(0, 2) Set src = src.Offset(1, 0) Do While src.Value = curInvoice dest.Value = src.Offset(0, 1).Value Set dest = dest.Offset(0, 1) Set src = src.Offset(1, 0) Loop Set dest = dest.Offset(1, 0).End(xlToLeft) Loop Application.screenUpdating = True End Sub