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'语句。这是我目前收到的错误：

编译错误：下一步没有For

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

Answer 1

您写的IF语句都需要ELSE IF用于第二个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列。

样本输入

sample input

运行代码

之后

sample output

循环内的案例陈述

3 个答案:

样本输入

运行代码