循环内的案例语句

Question

如何在 VBA 的循环中创建 case 语句（或多个 if 语句）？

在此示例中，我有一个包含 4 个名称的列表，它们对应于 4 个不同的组。这些名称在电子表格的“C”列中，我想创建一个新列“D”列，其中列出了每个人的组名。

这是我目前正在使用的代码：

Sub AddGroupColumn()
   'Counts number of rows in sheet. Loops through rows.
   For i = 1 To Range("C1048576").End(xlUp).Row
       If Range("C2:C" & i).Value = "john.doe" Then
          Set Range("D2:D" & i).Value = "group 1"
       If Range("C2:C" & i).Value = "jane.doe" Then
          Range("D2:D" & i).Value = "group 2"
       If Range("C2:C" & i).Value = "james.doe" Then
          Range("D2:D" & i).Value = "group 3"
       If Range("C2:C" & i).Value = "jenn.doe" Then
          Range("D2:D" & i).Value = "group 4"
    Next i 
 End Sub

请提供有关如何修复上述代码的建议。我知道语法已关闭，我不确定是否应该使用“If/Then/Else/Elseif”的“Case”语句。这是我目前收到的错误：

编译错误：Next 没有 For

另外，请告知是否有更有效的方法来解决此问题。在真实案例中，有 12 个名称、12 个组和 100,000 行名称。

Answer 1

您所写的IF 语句都需要在第二个IF 语句上加上ELSE IF，然后在分组末尾加上END IF 语句。

你当然可以做一个CASE声明，如下：

Sub AddGroupColumn()
   'Counts number of rows in sheet. Loops through rows.
   For i = 1 To Range("C1048576").End(xlUp).Row
       Select Case Range("C2:C" & i).Value
           Case "john.doe"
                Range("D2:D" & i).Value = "group 1"
           Case "jane.doe"
                Range("D2:D" & i).Value = "group 2"
           ' The rest of your case statements go here ...
       End Select
    Next i 
End Sub

Answer 2

您可以将名称和组放入数组中。

Sub AddGroupColumn()

    Dim rCell As Range
    Dim rRng As Range
    Dim vaNames As Variant
    Dim vaGroups As Variant
    Dim lMatch As Long

    vaNames = Array("john.doe", "jane.doe", "james.doe", "jenn.doe")
    vaGroups = Array("group 1", "group 2", "group 3", "group 4")

    With Sheet1
        Set rRng = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
    End With

    For Each rCell In rRng.Cells
        lMatch = Application.WorksheetFunction.Match(rCell.Value, vaNames, False)
        rCell.Offset(0, 1).Value = vaGroups(lMatch - 1)
    Next rCell

End Sub

请注意，在您的示例中，您没有指定范围适用于哪个工作表。这些被称为不合格的范围引用，可能会导致一些意外行为。如果您的代码在标准模块中，则非限定范围指的是 ActiveSheet。如果您的代码在工作表类模块中，则不合格范围指的是该工作表。

如果 C 列中的某些名称没有组，则必须更改循环以解决此问题。像这样

For Each rCell In rRng.Cells
    On Error Resume Next
        lMatch = Application.WorksheetFunction.Match(rCell.Value, vaNames, False)
    On Error GoTo 0

    If lMatch - 1 > LBound(vaGroups) Then
        rCell.Offset(0, 1).Value = vaGroups(lMatch - 1)
    Else
        rCell.Offset(0, 1).Value = "No group"
    End If
Next rCell

Answer 3

您可以使用数组完成所有这些操作，无需 If 或 Select Case 语句。这样可以避免每次将每个值写入工作表。

使用您的示例输入进行测试和工作（假设输入数据为单列）：

Sub AddGroupColumn()

Dim inputRange As Excel.Range
Dim inputData As Variant
Dim outputData As Variant
Dim i As Long, j As Long
Dim nameslist As Variant
Dim groupslist As Variant

' **** EDIT THESE AS NEEDED, however they MUST correspond
Const NAMES_LIST As String = "john.doe,jane.doe,james.doe,jenn.doe"
Const GROUPS_LIST As String = "group 1,group 2,group 3,group 4"

' create arrays of names and groups
nameslist = Split(NAMES_LIST, ",")
groupslist = Split(GROUPS_LIST, ",")

' define input range
Set inputRange = Range("C2:C" & Range("C" & Rows.Count).End(xlUp).row)

' read column C values into array
inputData = inputRange.value
' resize output array to match input array
ReDim outputData(LBound(inputData) To UBound(inputData), 1 To 1)

' evaluate input array, output to another array
For i = LBound(inputData) To UBound(inputData)
  For j = LBound(nameslist) To UBound(nameslist)
    If inputData(i, 1) = nameslist(j) Then ' given input value is matched on the names list
      outputData(i, 1) = groupslist(j) ' output array is the corresponding group name
      Exit For ' exit loop since we found what we need in this loop
    End If
  Next j
Next i

  ' write output data to output range
  inputRange.Offset(, 1).value = outputData

End Sub

当您将其应用于实际数据时，此过程将扩展。只需编辑这两个常量，确保它们的值对应。

通过使用 Rows.Count，无论 Excel 版本如何，它都将始终获取正确的范围。无论您拥有多少数据，数组都会自行调整大小。它所做的唯一假设是您的输入数据在一列中。

还请注意，我们只触摸工作表三次：一次定义输入范围，一次获取 C 列中的值，一次将计算值写回 D 列。

示例输入

运行代码后