比较范围并复制整行，当一些单元格匹配时？

我想比较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

比较范围并复制整行，当一些单元格匹配时？

回答

相关问题