你好,有人可以帮我吗? 我正在尝试使用 VBA 复制数据并搜索到另一个工作表。 我有 2 张纸,“Sheet1”(客户数据)和“原始数据”。 Sheet1 包含数千行,它们是唯一记录,而原始数据有 400 行,其中包含重复。我必须合并这两张纸并复制客户唯一记录并在原始数据中查找(包括重复)。 我尝试使用 For 循环,但它使程序变慢,因为它需要循环数千次。
感谢您的帮助和指导。
Sub Test2()
Dim last1, last2 As Long
Dim x, y As Integer
Sheets("Sheet1").Select
last1 = Worksheets("Sheet1").Range("J" & Rows.Count).End(xlUp).Row
For x = 2 To last1
Range("I" & x & ":K" & x).Select
Application.CutCopyMode = False
Selection.Copy
Worksheets(2).Select
Range("A" & x).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("M" & x).Select
Application.CutCopyMode = False
Selection.Copy
Worksheets(2).Select
Range("D" & x).Select
ActiveSheet.Paste
Sheets("raw data").Select
last2 = Worksheets("raw data").Range("G" & Rows.Count).End(xlUp).Row
For y = 2 To last2
If Worksheets(2).Range("B" & x).Value = Worksheets("raw data").Range("G" & y).Value Then
Worksheets("raw data").Select
Range("G" & y & ":J" & y).Select
Selection.Copy
Worksheets(2).Select
If IsEmpty(Range("F" & x)) Then
Range("F" & x).Select
ActiveSheet.Paste
Worksheets("raw data").Select
Range("M" & y).Select
Selection.Copy
Worksheets(2).Select
Range("E" & x).Select
ActiveSheet.Paste
Else
x = x + 1
Range("F" & x).Select
ActiveSheet.Paste
Worksheets("raw data").Select
Range("M" & y).Select
Selection.Copy
Worksheets(2).Select
Range("E" & x).Select
ActiveSheet.Paste
End If
End If
Next
Sheets("Sheet1").Select
Next
End Sub