当单元格值匹配时，使用 vba 以正确的顺序将所有数据从一个工作表复制到另一个工作表-解网

问：

你好我有 2 个 excel 文件：“销售报告”和“原始数据”。我想根据产品 ID 将数据从“原始数据”复制到“销售报告”，例如，“原始数据”包含 10 个产品 ID，但是，我只想在“销售报告”中包含 4 个产品 ID 的信息。原来的“销售报告”只包含一个产品 ID 列，其他列只有标题，没有数据。

例：原始数据（注意：第一行是 Excel 默认的 colume 名称，第二行由我的标题组成）：

A             B       C          D          E                 F             G            H
Product ID    Store   StoreID    Quantity   Price per unit    Total price   CustomerID   Month 
AB001         NY      01         2          5                 10            A135324      04/2023
GHI001        SE      07         1          15                15            Z457246      07/2023
ACA001        CH      03         6          10                60            H293847      06/2023
JF001         OH      02         1          30                30            L293720      03/2023
SSF001        NY      01         8          20                160           B725183      06/2023
BI001         NY      01         2          25                50            J347346      04/2023
LA001         CO      09         3          4                 12            D346435      07/2023
OP001         SE      07         1          250               250           J959942      05/2023
RH001         OH      02         2          3                 6             A562450      04/2023
KQ001         NY      01         10         12                120           C662036      06/2023

销售报告预计是这样的：

A             B        C            D       E          F                 G            H
Product ID    Month    CustomerID   Store   StoreID    Price per unit    Quantity     Total price
AB001         04/2023  A135324      NY      01         5                 2            10
OP001         05/2023  J959942      SE      07         250               1            250
ACA001        06/2023  H293847      CH      03         10                6            60
KQ001         06/2023  C662036      NY      01         12                10           120

2 个文件中的列顺序不一样，我想在“原始数据”中查找产品 ID，如果与“销售报告”中的产品 ID 匹配，则其他列中的数据将复制并粘贴到“销售报告”中并按正确的顺序粘贴。

以下是我的脚本：

Sub Main_content()
    
    Dim ws_copy As Worksheet
    Dim ws_paste As Worksheet
    Dim LastRow As Long
    Dim i As Long
    
    Workbooks.Open "C:\HP\Users\Downloads\Raw data.xlsx.xlsx"
    
    
    Set ws_copy = Workbooks("Raw data.xlsx").Sheets("sheet1")
    Set ws_paste = Workbooks("Sales report.xlsx").Sheets("sheet1")
    
    With ws_copy
      
      LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
   
    End With
    

   For i = 2 To LastRow
   
    With ws_copy
    On Error Resume Next
    
        If WorksheetFunction.Match(ws_copy.Range("A" & i), ws_paste.Range("A:A"), 0) <> 0 Then
            .Cells(i, "B").Copy Destination:=ws_paste.Range("D" & i)
            .Cells(i, "C").Copy Destination:=ws_paste.Range("E" & i)
            .Cells(i, "D").Copy Destination:=ws_paste.Range("G" & i)
            .Cells(i, "E").Copy Destination:=ws_paste.Range("F" & i)
            .Cells(i, "F").Copy Destination:=ws_paste.Range("H" & i)
            .Cells(i, "G").Copy Destination:=ws_paste.Range("C" & i)
            .Cells(i, "H").Copy Destination:=ws_paste.Range("B" & i)
        
        Else
            .Cells(i, "A").EntireRow.Delete
            
        End If

   End With

Next i

End Sub

我对VBA不是很熟悉，所以我的想法是遍历“原始数据”中A列中的所有单元格，如果它与“销售报告”中指定的产品ID匹配，则复制所有数据，如果不是，则删除“原始数据”中的行。（我知道这不是一个好主意，因为数据应该保留而不是删除）但是，当我运行代码时，“原始数据”中的所有 10 行都粘贴在“销售报告”中，有些甚至是错误的产品 ID。

任何反馈都非常感谢！非常感谢！

Excel VBA for 循环 if 语句

Sub Main_content()

    Const RAWDATA = "C:\HP\Users\Downloads\Raw data.xlsx.xlsx"
    Const SALES = "Sales report.xlsx"
    
    Dim wbCopy As Workbook, wbPaste As Workbook
    Dim wsCopy As Worksheet, wsPaste As Worksheet
    Dim rngPaste As Range, m As Variant
    Dim lastrow As Long, i As Long, n As Long
    
    Set wbCopy = Workbooks.Open(RAWDATA)
    Set wsCopy = wbCopy.Sheets("sheet1")
    
    Set wbPaste = Workbooks(SALES)
    Set wsPaste = wbPaste.Sheets("sheet1")
    
    With wsPaste
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rngPaste = .Range("A1:A" & lastrow)
    End With
    
    Application.ScreenUpdating = False
    With wsCopy
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = lastrow To 2 Step -1
             m = Application.Match(.Cells(i, "A"), rngPaste, 0)
             If Not IsError(m) Then
                .Cells(i, "B").Copy Destination:=wsPaste.Range("D" & m)
                .Cells(i, "C").Copy Destination:=wsPaste.Range("E" & m)
                .Cells(i, "D").Copy Destination:=wsPaste.Range("G" & m)
                .Cells(i, "E").Copy Destination:=wsPaste.Range("F" & m)
                .Cells(i, "F").Copy Destination:=wsPaste.Range("H" & m)
                .Cells(i, "G").Copy Destination:=wsPaste.Range("C" & m)
                .Cells(i, "H").Copy Destination:=wsPaste.Range("B" & m)
                n = n + 1
            Else
                .Cells(i, "A").Interior.Color = vbRed
                '.Cells(i, "A").EntireRow.Delete
            End If
        Next
    End With
    Application.ScreenUpdating = True
    MsgBox n & " rows matched", vbInformation

End Sub

当单元格值匹配时，使用 vba 以正确的顺序将所有数据从一个工作表复制到另一个工作表

Copy all data from one worksheet to another worksheet in a right order when a cell value matches using vba

评论

评论