Question

我正在处理电子表格的功能，该功能会根据列对行进行分组，然后计算每个组中的数字，同时对该组进行分类。

我有一份姓名和家庭状况清单，例如：

Bob     Employee    
Laura   Spouse    
Steve   Child    
Jim     Employee    
Brian   Employee    
Amy     Spouse    
Jon     Employee    
Kelly   Child

我希望员工按照家属和分层系统列表进行分组......看起来像这样

Name     # Dependents    Tier    
Bob           2         EE+Family    
Jim           0         EE    
Brian         1         EE+Spouse    
Jon           1         EE+Child

我一直试图采用嵌套if方法

For i=1 to NumberOfRows

  If status(i) = spouse

    go up 1 row increment dependent count & add EE+Spouse, delete row

  Else if status(i) = kid

    go up 1 row increment dependent & add EE+child

但这只有在只有一个孩子或配偶的情况下才有效...而不是两者兼而有之。还忘了提到这些名单将始终与员工一起订购，然后是家属。非常感谢任何帮助！

Answer 1

我决定使用数组来加速它。

这也将数据放入E1，可以更改。

这会向后循环，直到找到＆＃34;员工＆＃34;

Sub foo()
Dim inarr() As Variant
Dim oarr() As Variant
Dim ws As Worksheet
Dim cnt As Long
Dim spouse As Integer
Dim child As Integer


Set ws = ActiveSheet

With ws
    inarr = .Range("A2", .Cells(.Rows.Count, "B").End(xlUp)).Value
    cnt = WorksheetFunction.CountIf(.Range("B:B"), "Employee")
    ReDim oarr(1 To cnt, 1 To 3)
End With
cnt = 1
For i = UBound(inarr, 1) To 1 Step -1
    Select Case inarr(i, 2)
        Case "Spouse"
            spouse = spouse + 1
        Case "Child"
            child = child + 1
        Case "Employee"
            oarr(cnt, 1) = inarr(i, 1)
            oarr(cnt, 2) = spouse + child
            If spouse > 0 And child > 0 Then
                oarr(cnt, 3) = "EE+family"
            ElseIf spouse > 0 And child = 0 Then
                oarr(cnt, 3) = "EE+Spouse"
            ElseIf spouse = 0 And child > 0 Then
                oarr(cnt, 3) = "EE+Child"
            Else
                oarr(cnt, 3) = "EE"
            End If
            spouse = 0
            child = 0
            cnt = cnt + 1
    End Select
Next i
ws.Range("E1").Resize(UBound(oarr, 1), 3).Value = oarr

End Sub

Answer 2

通过设置＆＃34; Tier＆＃34;对于数值，您可以稍后将其更改为文本。这样，你会得到这样的东西：

Sub dadada()
  Dim data As Variant, output() As Variant, i As Long, j As Long, mb As VbMsgBoxResult
  With Sheets("sheet1")
    data = .[A1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 2).Value2
    ReDim output(1 To UBound(data), 1 To 3)
    output(1, 1) = "Name"
    output(1, 2) = "# Dependents"
    output(1, 3) = "Tier"
    j = 1
    For i = 1 To UBound(data)
      If data(i, 2) = "Employee" Then
        j = j + 1
        output(j, 1) = data(i, 1)
        output(j, 2) = 0
        output(j, 3) = 0
      ElseIf data(i, 2) = "Spouse" Then
        output(j, 2) = output(j, 2) + 1
        output(j, 3) = output(j, 3) Or 1
      ElseIf data(i, 2) = "Child" Then
        output(j, 2) = output(j, 2) + 1
        output(j, 3) = output(j, 3) Or 2
      ElseIf Len(data(i, 2)) Then '<- skip start
        mb = MsgBox("Can't evaluate '" & data(i, 2) & "' at row " & i & " ('" & data(i, 1) & "')!", vbAbortRetryIgnore + vbApplicationModal + vbCritical, "Error")
        If mb = vbAbort Then Exit Sub
        If mb = vbRetry Then
          If MsgBox("Is this a new employee?", vbYesNo) = vbYes Then
            data(i, 2) = "Employee"
          ElseIf MsgBox("Is this a new spose?", vbYesNo) = vbYes Then
            data(i, 2) = "Spouse"
          Else
            MsgBox "'" & data(i, 2) & "' will be used as 'Child'."
            data(i, 2) = "Child"
          End If
          i = i - 1
        End If '<- skip end
      End If
    Next
    For i = 2 To j
      output(i, 3) = "EE" & Application.Choose(output(i, 3) + 1, "", "+Spouse", "+Child", "+Family")
    Next
    .[E1].Resize(i - 1, 3).Value = output
  End With
End Sub

mb部分是可选的（因此，如果您不喜欢它，只需删除skip start和skip end之间的所有行

}

VBA代码分组和索引

2 个答案: