从一张工作表复制数据并在不同的工作表中搜索

时间:2021-01-25 02:45:42

标签: excel vba

你好,有人可以帮我吗? 我正在尝试使用 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

0 个答案:

没有答案