VBA代码分组和索引
我正在处理电子表格的function，该function将根据列对行进行分组，然后计算每个组中的数字，同时对组进行分类。
我有一个名单和家庭状况如下列表：
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
我一直试图采取嵌套的方法
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
但是，这只有当只有一个孩子或配偶，而不是两个。 也忘记提及名单将始终与员工第一，其次是受抚养人。 任何帮助深表感谢！
通过将“层”设置为数值，您可以稍后将其更改为文本。 这样，你会得到这样的东西：
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 ）
我决定使用数组来加快一点。
这也将把数据放在E1中，可以改变。
这向后循环保持计数，直到find“员工”
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
