VBA代碼組和索引

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 

我一直在試圖採取嵌套如果方法

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

通過設置「梯隊」的數值，你可以改變它的文本以後。這樣的話，你會得到這樣的事情：

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）

Answer 2

我決定用數組來加快它的速度。

這也將數據放在E1中，可以改變。

此迴路保持向後計數，直到它找到「僱員」

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