excel - 如果满足多个条件，数据从一个工作簿传输到另一个工作簿

Question

我有两个 excel 文件（wb1 和 wb2），从这些 excel 文件中，我只使用每个工作表中的第一个工作表（ws1 用于 wb1，ws2 用于 wb2）。我需要的是 ws1 中 A 中的每个单元格检查 ws2 中 B 中写入的相同数据，如果我找到匹配项，并且如果在 ws1 中我有 B 值“1”和 U 值“YES”，并且在 ws2 中我有 G 值“没关系”，然后将我在 D 中的内容从 ws2 复制到 X 从 ws1。

然后我必须再次检查来自 ws1 的 A 和来自 ws2 的 B 之间的匹配，但是来自 ws1 的 B 上的值必须是 "2" ，来自 ws1 的 U 上的值必须是 "YES" 和来自 ws2 的 G 上的值 "It is not ok "，然后像第一种情况一样复制。第三种情况是：

如果我在两个工作簿中的 A 和 B 之间没有匹配，或者如果 G(ws2) 中的值不是“没问题”或“没问题”，那么我在 ws1 的 X 中写的是什么是“未找到

“。 请帮忙

这是我到目前为止写的内容，但是它需要花费大量时间来运行并且它没有做它应该做的事情：

Sub CheckAndFill()

Application.Calculation = xlCalculationManual

    Application.EnableEvents = False

Dim wb1 As Workbook
Dim wb2 As Workbook


'Dim n As Long

Dim c1 As Object

Dim aCell As Object

Dim lRow1 As Long, lRow2 As Integer, lRow3 As String
Dim lRow4 As Long, lRow5 As Long, lRow6 As String, lRow7 As Long

Dim Rng1 As Object

Dim Rng2 As Object

Dim Rng3 As Object

Dim Rng4 As Object, Rng5 As Object, Rng6 As Object
Dim Rng7 As Object

Set wb1 = Workbooks("wb1.xlsx")
Set wb2 = Workbooks("wb2.xls")

'for wb1 workbook

Dim ws1 As Worksheet 
Set ws1 = wb1.Worksheets("xxx")


'for wb2 workbook

Dim ws2 As Worksheet 
Set ws2 = wb2.Worksheets("yyy")


'with the first workbook i`m trying to get to the last row

With ws1

 lRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Rng1 = .Range("A3:A" & lRow1)

        lRow2 = .Range("B" & .Rows.Count).End(xlUp).Row
        Set Rng2 = .Range("B3:B" & lRow2)

         lRow3 = .Range("U" & .Rows.Count).End(xlUp).Row
        Set Rng3 = .Range("U3:U" & lRow3)

         lRow4 = .Range("X" & .Rows.Count).End(xlUp).Row
        Set Rng4 = .Range("X3:X" & lRow4)
        
   
    End With
    
    
   'same as above with the second workbook

    With ws2

     lRow5 = .Range("B" & .Rows.Count).End(xlUp).Row
        Set Rng5 = .Range("B2:B" & lRow5)

         lRow6 = .Range("G" & .Rows.Count).End(xlUp).Row
        Set Rng6 = .Range("G2:G" & lRow6)

         lRow7 = .Range("D" & .Rows.Count).End(xlUp).Row
        Set Rng7 = .Range("D2:D" & lRow7)
        
        
       
      
 For Each c1 In Rng1

Set aCell = Rng5.Find(what:=cl.Value, LookIn:=xlValues)

 For Each aCell In Rng5

         If c1 = aCell And ws1.Range("B" & lRow2).Value = "1" And ws1.Range("U" & lRow3).Value Like "YES" And ws2.Range("G" & lRow6).Value Like "It is ok" Then

ws2.Range("D" & lRow7).Copy ws1.Range("X" & lRow4)

Else

If c1=aCell and ws1.Range("B" & lRow2).Value = "2" And ws1.Range("U" & lRow3).Value Like "YES" And ws2.Range("G" & lRow6).Value Like "It is not ok" Then

ws2.Range("D" & lRow7) = ws1.Range("X" & lRow4)

Else

If c1 <> aCell Or ws2.Range("G" & lRow6)  <> "It is ok" Or ws2.Range("G" & lRow6) <> "It is not ok" Then

ws1.Range("X" & lRow4).Value2 = "Not Found"

End If

End If

End If

    Next

    Next

    End With

     Application.Calculation = xlCalculationAutomatic

    Application.EnableEvents = True

End Sub

标签： excelvba