Question

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

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

相反：

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

我想过使用带有发票的高级过滤器的宏来浏览每个单元格 - 计算可见行并将详细信息复制到电子表格上的指定位置，然后删除只有一个详细编号的额外发票编号。但是，这似乎效率低下。

这是我到目前为止所提出的内容

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

试试这个宏。它会创建一个新工作表，按行对发票进行分组。它假设数据是在第二行开始的工作表（“发票”）列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

复制相似值的数据

1 个答案: