VBA（Excel）：循环复制多个工作表中的多个条件

背景
我有一个主文件，其中包含许多数据，我有一个不断更新的请求更改列表。 我需要编写一个macros，使其将在“更改”表中的每一行中运行，并在实际数据表中find其对应部分。 我需要将相关的单元格从更改工作表复制到其所在行中的相应行中。

信息

• 每个观察在A栏（ LOBID ）中都有一个通用标识符，
• 在列E（ CourseCode ）中也有一个特定的标识符

• 每一对都是唯一的，因为每个CourseCode可以在多个LOBID下的多个LOBID表中存在，但只能与一个LOBID一次。

   Sub InputChanges() Dim changeWS As Worksheet: Dim destWS As Worksheet Dim rngFound As Range: Dim strFirst As String Dim LOBID As String: Dim CourseCode As String Dim i As Integer: Dim LastRow As Integer Const SHEET_NAMES As String = "Sheet A, Sheet B, Sheet C, etc." Set changeWS = Sheets("Changes") Application.DisplayAlerts = False Application.ScreenUpdating = False For Each destWS In ActiveWorkbook.Worksheets If InStr(1, SHEET_NAMES, destWS.Name, vbBinaryCompare) > 0 Then For i = 4 To changeWS.Range("A" & Rows.Count).End(xlUp).Row LOBID = changeWS.Cells(i, 2) CourseCode = changeWS.Cells(i, 5) Set rngFound = Columns("A").Find(LOBID, Cells(Rows.Count, "A"), xlValues, xlWhole) If Not rngFound Is Nothing Then strFirst = rngFound.Address Do If Cells(rngFound.Row, "E").Value = CourseCode Then Cells(rngFound.Row, "AP").Value = changeWS.Cells(i, 24).Value End If Set rngFound = Columns("A").Find(LOBID, rngFound, xlValues, xlWhole) Loop While rngFound.Address <> strFirst End If Next i End If Next Set rngFound = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

这是我迄今为止的尝试，我有一种感觉很好，但我希望这个逻辑至less有意义。 我试图通过更改工作表中的每一行运行，search所有表格（A，B，C，… L）为LOBID，然后为CourseCode。 当find匹配对时，我希望将数据从changeWS复制到数据表中匹配的单元格（有许多要复制的值，但为了简化代码，我已经将其忽略）。 它不会抛出任何错误，但它似乎并没有做任何事情。 如果有人能够把我推向正确的方向，我会很感激。

Answer 1

编译但未经testing：

 Sub InputChanges() Dim changeWS As Worksheet, rw As Range Dim i As Integer Set changeWS = ActiveWorkbook.Sheets("Changes") Application.DisplayAlerts = False Application.ScreenUpdating = False For i = 4 To changeWS.Range("A" & Rows.Count).End(xlUp).Row Set rw = GetRowMatch(CStr(changeWS.Cells(i, 2)), CStr(changeWS.Cells(i, 5))) If Not rw Is Nothing Then rw.Cells(1, "AP").Value = changeWS.Cells(i, 24).Value changeWS.Cells(i, 2).Interior.Color = vbGreen Else changeWS.Cells(i, 2).Interior.Color = vbRed End If Next i Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Function GetRowMatch(LOBID As String, CourseCode As String) As Range Dim arrSheets, s, sht As Worksheet, rv As Range, f As Range Dim addr1 As String arrSheets = Array("Sheet A", "Sheet B", "Sheet C") ', etc.") For Each s In arrSheets Set s = ActiveWorkbook.Sheets(s) Set f = s.Columns(1).Find(LOBID, Cells(Rows.Count, "A"), xlValues, xlWhole) If Not f Is Nothing Then addr1 = f.Address() Do If f.EntireRow.Cells(5) = CourseCode Then Set GetRowMatch = f.EntireRow 'return the entire row Exit Function End If Set f = s.Columns(1).Find(LOBID, f, xlValues, xlWhole) Loop While f.Address() <> addr1 End If Next s 'got here with no match - return nothing Set GetRowMatch = Nothing End Function