Zelle speichern, aber leere Zellen ausschließen:

Question

Ich schreibe einen Code, der Spalte B nach Namensänderungen durchsucht und dann eine Zeile und Formeln auf der Basis von Variablendaten in Spalten E: J einfügt, wenn sich der Name ändert (neuer Wert) in der Zelle). Einige Namen werden mehr als einmal, aber nacheinander in Spalte B aufgeführt, und ich möchte sie zusammen für eine Summe pro Person gruppieren, aber sie tut derzeit jedes Mal eine Summe, wenn in Spalte B irgendwelche Daten vorhanden sind, nicht nur jedesmal der Name Änderungen. Das andere Problem, das ich habe, ist, dass es die letzte Person nicht summiert, weil es in Spalte B nach dem Nachnamen nichts als leere Zellen gibt, so dass sich nichts ändern wird, um "DANN" zu aktivieren. Ich freue mich über Feedback zu meinem Code. Hier ist, was ich derzeit haben:

Dim firstrow As Integer 
' Start on row 7 to avoid including header 
row = 7 
firstrow = 1 
previous = Range("B7").value 
While row < 1000 
'  Move to next row 
    row = row + 1 
    current = Range("B" & row).value 
    If current <> "" And current <> previous Then 
    Rows(row).Insert shift:=xlDown 
'   Formulas for Columns G, I, J, and K 
     Range("G" & row).Formula = "=SUM(E" & firstrow + 2 & ":G" & row - 1 & ")" 
     Range("I" & row).Formula = "=sum(H" & firstrow + 2 & ":I" & row - 1 & ")" 
     Range("J" & row).Formula = WS.Range("G" & row) - WS.Range("I" & row) 
     Range("K" & row).Formula = WS.Range("J" & row)/WS.Range("G" & row) 

     row = row 
     firstrow = row 
    End If 
    previous = current 
Wend 

Answer 1

Sie einen anderen Ansatz in Erwägung ziehen könnte:

• Schleifen Reihen in umgekehrter Reihenfolge von den letzten ein bis erste

• mit AutoFilter() und Specialcells() Methoden Range Objekt zu isolieren Blöcke von zusammenhängenden nicht leere Zellen, wo Summen Formeln geschrieben werden

wie folgt:

Option Explicit 

Sub main() 
    Dim iRow As Long 
    Dim area As Range 

    With Range("B1", Cells(Rows.Count, 2).End(xlUp)) 
     For iRow = .Rows.Count To 2 Step -1 
      If .Cells(iRow, 1) <> .Cells(iRow + 1, 1) Then .Rows(iRow + 1).EntireRow.Insert shift:=xlDown 
     Next 
     .AutoFilter Field:=1, Criteria1:="<>" 
     If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then 
      Set area = .SpecialCells(xlCellTypeVisible) 
      .Parent.AutoFilterMode = False 
      For Each area In area.Areas 
       With area.Offset(area.Rows.Count).Resize(1) 
        .Offset(, 5).Formula = "=SUM(" & Intersect(Range("E:G"), area.EntireRow).Address & ")" 
        .Offset(, 7).Formula = "=SUM(" & Intersect(Range("H:I"), area.EntireRow).Address & ")" 
        .Offset(, 8).FormulaR1C1 = "=RC7-RC9" 
        .Offset(, 9).FormulaR1C1 = "=RC10/RC7" 
       End With 
      Next 
     End If 
    End With 
End Sub