| Teilergebnisse |
|
|
| Um Bereiche statistisch auszuwerten hat Excel nur eingeschränkte Möglichkeiten. Im nachfolgenden Fall sollen |
| Umsätze diverser Kunden addiert und nach Rechnungs- und Gutschriftssumme getrennt werden: |
|
| Sub GetQuantity() |
| Dim rang As Range, wwb As Worksheet |
| Dim strTxt1$, strTxt2$, n&, q&, o&, r&, loops& |
| Dim wert2 As Range, x& |
| Set wwb = Worksheets(1) |
| x = 0: n = 1 'Zeile 1 enthält Überschriften |
| wwb.AutoFilterMode = False |
| q = wwb.UsedRange.Rows.Count |
| wwb.Range("A2:N" & q).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _ |
| xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom |
| wwb.Range("J2:N" & q).Value = "" |
| Application.ScreenUpdating = False |
| Do Until n = q |
| Application.StatusBar = n & " lines done" |
| n = n + 1 |
| strTxt1 = wwb.Range("A" & n).Value |
| strTxt2 = wwb.Range("A" & n + 1).Value |
| If strTxt1 <> "" Then |
|
| Set rang = wwb.Range("A2:A" & q) |
| For Each rang In rang.Cells |
| If strTxt1 = rang.Value Then |
| If (strTxt1 = rang.Value And loops >= 1) _ |
| Or (strTxt1 <> strTxt2) Then |
| x = rang.Row |
| |
| Set wert2 = wwb.Range("B" & x) |
| wwb.Range("N" & n).Value = wwb.Range("N" & n).Value + wert2.Value2 |
| Select Case wert2.Value2 |
| Case Is >= 0: |
| o = o + 1 |
| wwb.Range("J" & n).Value = o 'Order |
| wwb.Range("L" & n).Value = wwb.Range("L" & n).Value + wert2.Value2 |
| Case Else |
| r = r + 1 |
| wwb.Range("K" & n).Value = r 'Credit |
| wwb.Range("M" & n).Value = wwb.Range("M" & n).Value + wert2.Value2 |
| End Select |
| loops = loops + 1 |
| Set wert2 = Nothing |
| |
| End If |
| End If |
| wwb.Range("A" & n).Select |
| If n = x Then Exit For |
| Next rang |
| Set rang = Nothing |
| o = 0: r = 0: loops = 0 |
| |
| End If |
| Loop |
| wwb.Range("A1").Select |
| wwb.Range("A1:N" & q).AutoFilter Field:=14, Criteria1:="<>" |
| Set wwb = Nothing |
| Application.ScreenUpdating = True |
| End Sub |
 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| In Excel ist zwar eine Funktion "Teilergebnisse" eingebaut. Diese stößt aber bei Berechnungen, die über mehr als zwei |
| Spalten hinausgehen, an ihre Grenzen: |
 |
|
|
|
|
|
|
|
|
|
|
| . |
|
zurück