比較範圍並複製整行，當一些單元格匹配時？

我想比較2個不同的工作表中的2個範圍。比較範圍並複製整行，當一些單元格匹配時？

Sheet1("Raport")包含未貼上的客戶信息和應獲得的產品類型。
Sheet2("Dane")包含有關客戶的詳細信息，該信息應（如1個客戶=整行）被複制到特定薄片（例如Sheet3("Produkt1")，Sheet4("Produkt2")等的基礎上，客戶和產品列表（Sheet1("Raport")）。

刪除空行（作品）

Sub DeleteBlankRows1() 
    Dim i As Long 

    With Application 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 

     For i = Selection.Rows.Count To 1 Step -1 
      If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then 
       Selection.Rows(i).EntireRow.Delete 
      End If 
     Next i 

     .Calculation = xlCalculationAutomatic 
     .ScreenUpdating = True 
    End With 
End Sub

範圍Produkt1的（作品）的Produkt2（作品

Sub SelectBetween() 
    Dim findrow As Long, findrow2 As Long 

    findrow = Range("B:B").Find("Produkt1", Range("B1")).Row 
    findrow2 = Range("B:B").Find("Laczna ilosc Produkt1", Range("B" & findrow)).Row 
    Range("B" & findrow + 1 & ":M" & findrow2 - 1).Select 
End Sub

範圍）

Sub SelectBetween2() 
    Dim findrow As Long, findrow2 As Long 

    findrow = Range("B:B").Find("Produkt2", Range("B1")).Row 
    findrow2 = Range("B:B").Find("Laczna ilosc Produkt2", Range("B" & findrow)).Row 
    Range("B" & findrow + 1 & ":M" & findrow2 - 1).Select 
End Sub

如果要比較工作表並將詳細的客戶信息複製到另一個工作表中，我應該寫什麼？

Sub Compare() 
    Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet 
    Dim findrow1 As Long, findrow2 As Long 
    Dim range1 As Range, range2 As Range, c As Range 

    Set w1 = Worksheets("Raport") 
    Set w2 = Worksheets("Dane") 
    Set w3 = Worksheets("Produkt1") 

    findrow1 = w1.Range("B:B").Find("Produkt2", w1.Range("B1")).Row 
    findrow2 = w1.Range("B:B").Find("Laczna ilosc Produkt2", w1.Range("B" & findrow1)).Row 
    Set range1 = w1.Range("B" & findrow1 + 1 & ":M" & findrow2 - 1) 
    Set range2 = w2.Range("2:137") 

    If range1 = w2.range2 Then 
     range2.EntireRow.Copy w3.Cells(Rows.Count, 1).End(xlUp)(2) 
    End If 
End Sub

在附件有一個與最終結果（詳細的客戶信息被簡單地Produkt1和Produkt2表複製，而不使用宏）的文件。 - >https://uploadfiles.io/ttmck

來源

2017-05-30 havok2989

複製所需的與

range2.EntireRow.Copy

下一行範圍後，應粘貼：

Worksheets(1).Paste Destination:=Worksheets(1).Cells(Rows.Count, 1).End(xlUp)(2, 1)

與您的目標替代Worksheets(1)。這會將所有複製的行放置到目標工作表上的連續行，最終您可能需要對該範圍應用RemoveDuplicates。

來源

2017-05-30 10:33:58 avb

比較範圍並複製整行，當一些單元格匹配時？

回答

相關問題