Zählen von Werten in Kombi mit Formeln - wer kann einen Hinweis geben?

[Nermelnchen]

Hallo zusammen,

ich muss einzelner Werte in einer Tabelle (alles in einer Spalte, getrennt durch slash, manche Werte sind mit "*" als Multiplikator zu sehen) zusammenzählen lassen. Ein händisches Zählen wäre fehlerhaft und dauert zu lange.

Bsp: 
Es muss ermittelt werden, wie oft die einzelnen Werte in dieser Spalte vorhanden sind (z.B. sollte das Ergebnis so aussehen: 
A20 3 (3 mal vorhanden)
A35 5 (5 mal vorhanden)
E20 1
E35 6 usw

Achtung: einzelne Werte haben ein "*" davor, was z. B. bedeutet 5*A10 => 5 mal der Wert A10

Es gibt theoretisch bis zu 300 verschiedenen Werte, i.d.R. Buchstabe davor mit einer zweistelligen Ziffer. Jede Spalte kommt in einer einzelnen Excel-Datei, mir würde aber eine Formel reichen, die ich immer eintragen kann. Die Länge der Spalten und die Anzahl der Werte kann sehr kurz oder auch sehr lang sein.

Leider kann ich an der Formatierung nichts ändern, muss es nehmen wie es ist.

Bsp der Spalte in einer Excel-Datei:

A20/G10/G41/K41/K43/K90/
A70/D21/
A30/L301/
A20/D22/D62/2*K17/6*K20/29*K21/6*K30/4*K32/10*K33/4*K41/K90/L104/2*L20/2*L92/L95/
A80/D64/G32/2*K21/12*K30/14*K31/3*K41/K62/K91/L104/
A20/D62/K15/20*K31/12*K32/9*K33/2*K41/K61/K80/K90/3*L20/
A10/G31/K17/6*K30/K53/2*K61/K80/5*K90/L90/
A10/D20/D62/G31/K17/10*K21/5*K31/6*K32/K52/2*K90/2*L20/L21/L301/L45/L90/
A10/G41/K17/14*K21/10*K31/K52/6*K90/L21/L301/L45/L90/
A30/K11/L301/
A30/K17/
A80/D64/G10/K17/7*K30/9*K31/4*K41/K61/K80/3*K90/L102/L22/L301/L33/
A20/K17/6*K32/K33/K90/2*L20/L301/
A20/D62/G10/G41/K17/2*K32/8*K41/K54/K61/4*K80/2*K90/L106/L20/L22/L301/L33


Hat jemand eine Idee für mich, ich bin am verzweifeln?!  :22:

[Fennek]

Hallo,

mt "quick & dirty", d.h. ein kleiner Makro und eine Pivot-Tabelle. Es ist eher ein "proof-of-concept" und bedarf mit den Originaldaten noch etwas Nachbearbeitung.

mfg

[Nermelnchen]

Hallo Fennek,

vielen Dank. Ich habe glaube ich Deine 2-Schritte-Technik nachvollziehen können: zuerst Auflistung der einzelnen Werte und das dann in eine Pivot. Wie hast Du denn das Makro mit der Auflistung (also Schritt 1) bitte gemacht? 

[Fennek]

Hallo,

hm, deine Rückfrage is etwas schwierig zu verstehen...

Falls du einmal ein Grundlagenbuch in vba durchgerbeitest hast, dürftest du die meisten Code kennen, bei einigen Array-Funktionen (".resize") kann es noch Lernbedarf geben.

Ich werde dir sicher nicht Zeile für Zeile erklären, also kann ich mit deiner Rückfrage schlecht umgehen.

mfg

[WillWissen]

Hi Fennek,

Ich werde dir sicher nicht Zeile für Zeile erklären,

es gibt sicherlich noch so einige andere, die hier mitlesen und vor allem mitlernen möchten. Mich eingeschlossen. :05: Wäre es dir eventuell nicht möglich, deine Codezeilen mit erklärenden Kommentaren zu versehen? Das hilft vielen bestimmt, sich in die Materie VBA einzuarbeiten.

[Fennek]

an alle, die es interessiert:

Code:

Sub iT1()
Dim WS As Worksheet
Set WS = ActiveSheet

Range("C2:D1000").Clear
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
   lc = Cells(Rows.Count, "C").End(xlUp).Row + 1
   Ar = Split(Cells(i, "A"), "/")
   Cells(lc, "C").Resize(UBound(Ar) + 1) = Application.Transpose(Ar)
Next i
For i = 2 To lc + UBound(Ar) + 1
   If InStr(Cells(i, "C"), "*") > 0 Then
       lr = Cells(Rows.Count, "C").End(xlUp).Row + 1
       f = Split(Cells(i, "C"), "*")
       Cells(lr, "C").Resize(f(0)) = f(1)
       Cells(i, "C").Clear
   End If
Next i
With WS.Sort
With .SortFields
       .Clear
       .Add Key:=WS.Range("C1"), Order:=xlAscending
     End With
     .Header = xlYes
     .SetRange Rng:=WS.Columns("C")
     .Apply
   End With
End Sub

Ich habe die Daten nicht sofort in ein Array eingelesen, um mit ".resize" den Faktor (z.B. 4*GF) einfach in die Anzahl der belegten Zellen übernehmen zu können. Die längere Laufzeit sollte zu verschmerzen sein.

mfg

[atilla]

Hallo,

das ist eine schöne Aufgabe für Scripting.Dictionary

Code:

Sub mach()
  Dim i As Long, j As Long
  Dim lngZ As Long
  Dim feld
  Dim varStrg

  Dim c As Object
  Set c = CreateObject("Scripting.Dictionary")
 
  With Sheets("Beispiel ")
    lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
    feld = Range("A2:A" & lngZ)
    
    For i = LBound(feld) To UBound(feld)
      varStrg = Split(feld(i, 1), "/")
        For j = LBound(varStrg) To UBound(varStrg)
          If Val(varStrg(j)) > 0 Then
            c(Split(varStrg(j), "*")(1)) = c(Split(varStrg(j), "*")(1)) + Val(varStrg(j))
          Else
            c(varStrg(j)) = c(varStrg(j)) + 1
          End If
        Next j
    Next i
    .Columns("D:E").ClearContents
    .Range("D1:E1").Resize(c.Count) = Array("Abzurechnende Leistung", "Anzahl")
    .Range("D2:E2").Resize(c.Count) = Application.Transpose(Array(c.Keys, c.items))
    .Range("D1:E1").Resize(c.Count).Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False _
     , Orientation:=xlTopToBottom
  End With
    
End Sub

Das Sortieren, wie Fennek es hatte, wird vielleicht auch gebraucht, deswegen habe ich den Code dahingehend ergänzt.