VBA IF语句循环使用范围而不是单个值

Question

首先感谢您的帮助。

我一直在尝试获取一个动态列表，该列表根据IF条件将excel上的值复制到另一个列表中，该条件工作得很好。但是我只能针对1个条件而不是一定范围的条件进行此操作。

在excel中，我通常会使用COUNTIF函数来查看是否可以在另一个范围内找到一个范围的值，但是我对VBA还是很陌生，我不知道如何在范围的循环中表达这一点。

下面的示例适用于一种情况：

如您所见，我将“ Investor”作为条件，但我需要将其用于一定范围的值。

感谢您的帮助！

For i = 2 To LastRows

If Worksheets("Data").Range("F" & i).Value = "Investor" Then
'Instead of "Investor" I want to do something that take a list of values. Eg : If If Worksheets("Data").Range("F" & i).Value = "Range("A1:A"&LastRows) Then

Worksheets("Data").Range("A" & i).Copy
Worksheets("Email Format").Activate

LastRowEmail = Worksheets("Email Format").Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Email Format").Range("A" & LastRowEmail).Select
ActiveSheet.Paste

End If```

Answer 1

Application.Match与WorksheetFunction.Match

您可以使用以下Match解决方案之一。

Option Explicit

Sub MultiCriteria1()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wsD As Worksheet: Set wsD = wb.Worksheets("Data")
    Dim wsE As Worksheet: Set wsE = wb.Worksheets("Email Format")
    Dim LastRowD As Long: LastRowD = wsD.Cells(wsD.Rows.Count, 1).End(xlUp).Row
    Dim CurrentE As Long: CurrentE = wsE.Cells(wsE.Rows.Count, 1).End(xlUp).Row

    For i = 2 To LastRowD
        If Not IsError(Application.Match(wsD.Range("F" & i).Value, _
          wsD.Range("A1:A" & LastRowD), 0)) Then
            CurrentE = CurrentE + 1
            wsE.Range("A" & CurrentE).Value = wsD.Range("A" & i).Value
        End If
    Next i
End Sub

Sub MultiCriteria2()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wsD As Worksheet: Set wsD = wb.Worksheets("Data")
    Dim wsE As Worksheet: Set wsE = wb.Worksheets("Email Format")
    Dim LastRowD As Long: LastRowD = wsD.Cells(wsD.Rows.Count, 1).End(xlUp).Row
    Dim CurrentE As Long: CurrentE = wsE.Cells(wsE.Rows.Count, 1).End(xlUp).Row
    Dim CurrVal As Long

    For i = 2 To LastRowD
        On Error Resume Next
        CurrVal = WorksheetFunction.Match(wsD.Range("F" & i).Value, _
          wsD.Range("A1:A" & LastRowD), 0)
        If Err.Number = 0 Then
            CurrentE = CurrentE + 1
            wsE.Range("A" & CurrentE).Value = wsD.Range("A" & i).Value
        End If
        On Error GoTo 0
    Next i
End Sub

Answer 2

这仅是示例，但应该引导您正确的方向。

Dim rngYourRange as Range
Set rngYourRange = Range("A1:C10")
Dim rngEachRange as Range

For each rngEachRange in rngYourRange 'or rngYourRange.Rows or rngYourRange.Columns
    if rngEachRange.value = 1 then 'or whatever
    'do what you need
    end if
next rngEachRange