Question

Dim ii As Long
Dim j As Long
Dim sheet1LastRow As Long
Dim sheet2LastRow As Long

sheet1LastRow = Worksheets("Final").Range("L" & Rows.Count).End(xlUp).Row
sheet2LastRow = Worksheets("2015new").Range("A" & Rows.Count).End(xlUp).Row

    For j = 2 To sheet1LastRow
        For ii = 2 To sheet2LastRow
            If Worksheets("Final").Cells(j, 1).Value = Worksheets("2015new").Cells(ii, 1).Value Then
              Worksheets("2015new").Rows(ii & ":" & ii).Copy Sheets("Extract").Range("A65536").End(xlUp).Offset(1)

            Else
            End If
    Next ii
Next j

查看论坛并提出上述代码，但它似乎无法正常工作。它还缓冲了一段时间才回来。任何帮助是极大的赞赏。一些额外的信息，两列都包含日期，它们的数量不相同。（意思是表1有大约100个日期，而表2有20个小时）

Answer 1

just looking for speed, something like this should help a lot:

Dim chkRng As Variant, runRng As Range, outRng As Range, i As Long
chkRng = Worksheets("Final").Range("L1", Worksheets("Final").Range("L" & Rows.Count).End(xlUp)).Value
For Each runRng In Worksheets("2015new").Range("A2", Worksheets("2015new").Range("A" & Rows.Count).End(xlUp))
  For i = 2 To UBound(chkRng)
    If chkRng(i, 1) = runRng.Value Then
      If outRng Is Nothing Then Set outRng = runRng.EntireRow Else Set outRng = Union(outRng, runRng.EntireRow)
      Exit For
    End If
  Next
Next
If Not outRng Is Nothing Then outRng.Copy Sheets("Extract").Range("A65536").End(xlUp).Offset(1)

Answer 2

我对您的代码进行了一些更改，希望它有所帮助。（未经测试）

Dim ii As Long
Dim j As Long
Dim sheet1LastRow As Long
Dim sheet2LastRow As Long

sheet1LastRow = Worksheets("Final").Range("L" & Rows.Count).End(xlUp).Row
sheet2LastRow = Worksheets("2015new").Range("A" & Rows.Count).End(xlUp).Row

    For j = 2 To sheet1LastRow
        For ii = 2 To sheet2LastRow
            If Worksheets("Final").Cells(j, 1).Value = Worksheets("2015new").Cells(ii, 1).Value Then
              Worksheets("2015new").Rows(ii).Copy Sheets("Extract").Range("A65536").End(xlUp).Offset(1,0)

            Else
            End If
    Next ii
Next j

VBA脚本用于查找工作表1上的列L和工作表2上的列A之间的匹配，然后粘贴工作表3上匹配的行

2 个答案: