Question

我需要在电子表格中搜索特定的字符串，如果找到了，则将找到的整个数据行复制到另一个工作簿中-这部分工作正常。 VBA根本不是我不熟悉的语言，我继承了此代码作为起点-我的主要问题是，它尚未检查该行的数据是否已复制到另一个工作簿中。复制。因此，每次运行（保存时）时，它将再次复制所有符合条件的行。

'Search code
LastRow = Alpha.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'Loop search code
For i = 2 To LastRow

   'Compare columns for mismatches
    If Alpha.Range("F" & i) <> Alpha.Range("G" & i) Then

   'Pull out mismatches if contain specific text
    Select Case True
       'Search for specific text
        Case (InStr(1, Alpha.Range("G" & i), "ABC") > 0)
       'Move mismatched row to next empty row in TrackSheet
            NextRow = TrackSheet.Rows(Rows.Count).End(xlUp).Row + 1
            Alpha.Rows(i).Copy
            TrackSheet.Rows(NextRow).PasteSpecial (xlPasteValues)
    End Select
    End If

Next i

任何帮助将不胜感激！！！我整天都在搜索论坛，但对VBA的掌握不足，无法为自己的代码量身定制任何解决方案。

Answer 1

假设两个工作表在ColA中都有唯一的ID，则可以使用Match检查现有行：

Dim CoderBook As Workbook
Dim CDIreview As Workbook
Dim Ophth As Worksheet
Dim VERA As Worksheet
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long, m

'Search code
LastRow = Ophth.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
                           SearchDirection:=xlPrevious).Row

'Loop search code
For i = 2 To LastRow

   'Compare columns for mismatch
    If Ophth.Range("F" & i) <> Ophth.Range("G" & i) Then

   'Pull out specific high priority mismatches
    Select Case True
       'Search strings in column H for high priority mismatches
        Case (InStr(1, Ophth.Range("G" & i), "H54") > 0)
            'Move mismatched row to next empty row in CoderBook/VERA sheet

            'look for Id match in destination sheet
            m = Application.Match(Ophth.Range("A" & i).Value, VERA.Columns(1), 0)
            If IsError(m) Then
                'no match on Id - copy values
                VERA.Cells(Rows.Count,1).End(xlUp).Offset(1,0).EntireRow.Value = _
                                                               Ophth.Rows(i).Value
            End If

    End Select
    End If

Next i

如何仅复制尚未复制到其他工作簿的数据行？

1 个答案: