VBA For 循环多个条件

Question

此 For 循环的任务是从两个工作表收集数据并在用户表单中使用它。在第一部分中，如果 EmplID 和今天的日期匹配，则应复制数据。如果不满足此条件，则仅复制 EmplID 和名称。不幸的是，这不起作用，并且在所有情况下都满足第一个条件。

If EmplID.Text = "" Then
MsgBox "Please enter your ID", vbCritical, "Alert"
Exit Sub
End If

Application.ScreenUpdating = False

Dim Empl_ID As String, found As Boolean
Dim lrow As Long, srow As Long, s As Date, i As Long, x As Long

Empl_ID = Trim(EmplID.Text)

lrow = Sheets("DatabaseIN").Cells(Rows.Count, "A").End(xlUp).Row
srow = Sheets("Stamp").Cells(Rows.Count, "A").End(xlUp).Row
s = Format(Date, "yyyy/mm/dd")

found = False


For i = 2 To lrow
    For x = 2 To srow
        If Sheets("DatabaseIN").Cells(i, 1).Value = Empl_ID And _
           Sheets("Stamp").Cells(x, 3).Value = Date Then

            txtName = Sheets("Stamp").Cells(x, 2).Value
            txtDate = Sheets("Stamp").Cells(x, 3).Text
            txtStart = Sheets("Stamp").Cells(x, 4).Text
            txtBreakOut = Sheets("Stamp").Cells(x, 5).Text
            txtBreakIn = Sheets("Stamp").Cells(x, 6).Text
            txtEnd = Sheets("Stamp").Cells(x, 7).Text
            found = True
            Exit For ' Kilépünk a belso ciklusból, mivel már megtaláltuk a megfelelo rekordot
        End If
    Next x
    
    If found Then
        Exit For ' Kilépünk a külso ciklusból is, mivel már megtaláltuk a megfelelo rekordot
    ElseIf Sheets("DatabaseIN").Cells(i, 1).Value = Empl_ID Then
        txtName = Sheets("DatabaseIN").Cells(i, 2).Value
        txtDate = s
    End If
Next i

Answer 1

例如，没有嵌套循环并使用 Match() 进行查找：

Sub Tester()
    
    Dim Empl_ID As String, found As Boolean
    Dim lrow As Long, srow As Long, s As Date, i As Long, x As Long
    Dim wsDBIn As Worksheet, wsStamp As Worksheet, mId, mDt

    Empl_ID = Trim(EmplID.Text)
    If Len(Empl_ID) = 0 Then
        MsgBox "Please enter your ID", vbCritical, "Alert"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Set wsDBIn = ThisWorkbook.Worksheets("DatabaseIN")
    Set wsStamp = ThisWorkbook.Worksheets("Stamp")
    
    mId = Application.Match(Empl_ID, wsDBIn.Columns("A"), 0)     'look for Id match
    mDt = Application.Match(CLng(Date), wsStamp.Columns("C"), 0) 'convert to Long for date matching...
    
    If Not IsError(mId) Then                'got a match on Id?
        txtName = wsDBIn.Cells(mId, 2).Value
        txtDate = Format(Date, "yyyy/mm/dd")
        
        If Not IsError(mDt) Then            'got a match on Date?
            txtStart = wsStamp.Cells(mDt, 4).Text
            txtBreakOut = wsStamp.Cells(mDt, 5).Text
            txtBreakIn = wsStamp.Cells(mDt, 6).Text
            txtEnd = wsStamp.Cells(mDt, 7).Text
        End If
    End If
    
End Sub