Question

所以我在同一个Excel工作簿上有几个工作表需要比较。工作表1是主列表，我需要比较工作表1-2,1-3,1-4。然后我需要在工作表5的A列中粘贴任何类似的1-2个数据单元，在工作表5的B列中粘贴类似的1-3个数据单元，并且与工作表5的C列有1-4个相似之处。对于初学者我有重点在1-2比较工作。到目前为止，我已经能够将我的测试编号粘贴到工作表5的单元格A1。我遇到麻烦，因为它只适用于1个单元格，我无法让程序在A1中粘贴相似性，然后A2 ...等，当我有多个类似的项目。它们只是在单元格A1或整个A列中相互覆盖。我也遇到了麻烦，因为它写入的程序在遇到空格时会停止，但我需要它才能跳过空白并在遇到它们时读取下一个单元格。这是因为我的数据表非常混乱，数据分散在几个不同列中的数千行中，随机插入空格。下面是我的工作代码，只是读取相似性，并将其粘贴到A1。我应该注意到，我已经考虑根据我所使用的工作表添加一个特定的单元格范围，以便在程序上设置一个终点，但我还没有弄清楚如何使用它。

Sub findDuplicates()
' code to find duplicates in 2 different worksheets

Dim rng1, rng2, rngA, cell1, cell2 As Range
' 4 ranges have been defined

Set rng1 = Sheets("Sheet1").Range("C:C")
'rng1 defines the existing data in column C and worksheet1

Set rng2 = Sheets("Sheet2").Range("C:C")
'rng2 defines the data in column C and worksheet2

Set rngA = Sheets("Sheet5").Range("A1")

For Each cell1 In rng1
    If IsEmpty(cell1.Value) Then Exit For
    'check for empty rows. If true then exit the program

    For Each cell2 In rng2
        If IsEmpty(cell2.Value) Then Exit For

        If cell1.Value = cell2.Value Then
            'compare data in cell1 and cell2 and then copy/paste if they have equal values
            cell1.Copy
            Sheets("Sheet5").Select
            rngA.Select
            ActiveSheet.Paste
        End If
        'run the looping process
    Next cell2
Next cell1

End Sub

我认为程序看起来像是

的一般概念

Define ranges

Block of code that runs through each cell in sheet 1 comparing it to all cells in sheet 2.

Block of code that, when similarities are found, copy/paste that cell on sheet 1 to sheet 5 column A

*Program resumes scan from the next cell on sheet 1*

Block of code that breaks the program when it hits the end of the specified cell range

对此有任何帮助将不胜感激！你会拯救我至少一周的盲目工作。

Answer 1

关于您的代码的一些评论：

Dim rng1, rng2, rngA, cell1, cell2 As Range表示只定义cell2 As Range，rng1, rng2, rngA, cell1定义As Variant
您不需要比较2个For循环，您可以使用For函数替换第二个Match循环，它将为您节省宝贵的运行时间。< / LI>
您需要使用NextRow = Sheets("Sheet5").Cells(Sheets("Sheet5").Rows.Count, "A").End(xlUp).Row + 1
最后，您不需要Select这些工作表就可以复制＆gt;＆gt;粘贴，您可以将其设置为1行（请参阅下面的代码）。

<强> 代码

Sub findDuplicates()
' code to find duplicates in 2 different worksheets

' 4 ranges have been defined
Dim rng1 As Range, rng2 As Range, rngA As Range, cell1 As Range, cell2 As Range
Dim NextRow As Long


'rng1 defines the existing data in column C and "Sheet1"
Set rng1 = Sheets("Sheet1").Range("C:C")

'rng2 defines the data in column C and "Sheet2"
Set rng2 = Sheets("Sheet2").Range("C:C")

Set rngA = Sheets("Sheet5").Range("A1")

For Each cell1 In rng1
    If Not IsEmpty(cell1.Value) Then ' only check non-empty cells
        If Not IsError(Application.Match(cell1.Value, rng2 , 0)) Then ' <-- confirm match was asuccessful
            ' find next empty row in column "A" in "Sheet5"
            NextRow = Sheets("Sheet5").Cells(Sheets("Sheet5").Rows.Count, "A").End(xlUp).Row + 1
            ' Copy >> Paste in 1 line (without need to Select the Sheets)
            cell1.Copy Destination:=Sheets("Sheet5").Range("A" & NextRow)
        End If
        'run the looping process
    End If
Next cell1

End Sub

Answer 2

你的问题是rngA指向A1并且没有任何改变。粘贴命令后添加一行：

.htaccess

尝试识别随机分布在2个单独的Excel工作表中的匹配单元格，并将匹配的数据复制并粘贴到第三个工作表中

2 个答案: