Clever-Excel-Forum

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:

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

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? Dodgy

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

Hi Fennek,

Zitat: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.

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

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.

Nermelnchen

Fennek

Nermelnchen

Fennek

WillWissen

Fennek

atilla