Aaaah! Tabelle erstellen mit Index

Liebe alle,

ich verzweifle vor allem weil ich das Problem schon mal gelöst habe, aber ich komm nicht dahinter.

Folgende Situation:

ich habe ein Übersichtsblatt, wo verschiedene Bereiche zusammenkommen und dargestellt werden.

Dieses nährt sich aus den Datumsangaben in den Spalten A von "Büro" und "Technik", Spalte B "Küche" und Spalte C "Klein" kommt aus der Spalte B "Abteilung" vom Blatt Büro. Die Techniker haben ihr eigenes tabellenblatt mit wenig PiPaPo.

Mein Problem: mit SVERWEIS kriege ich immer wieder Doppelungen, da sich Küche und Klein ja abwechseln als Abteilungsorte und ich immer nur 1 zeile weiter gehe wenn ich die Formel runterziehe.

Ich hatte mal was ähnliches mit INDEX und KKLEINSTE bei einer Buchhaltungsexcel, dass er mit KKLEINSTE in einer INDEX-Matrix gesucht hat und dadurch Zeilen überspringen konnte (ich glaub er hat immer den darüberliegenden Eintrag genommen und 1 hinzugefügt bei der Matrixangabe). Aber ich bekomme dieses scheinbar einfache Problem einfach nicht hin.

Im Endeffekt soll es so aussehen wie auf meinem ZIEL Blatt - am anfang die Beginnzeit, dann der Name und dann noch ein L, wenn bei Leitung "Ja" steht.

Bitte um Hilfe!
Hier die Datei:

https://www.herber.de/bbs/user/169541.xlsx

ja, ist eigentlich alles komplett ungeeignet für so eine Auswertung und Darstellung, aber was sollst

Challenge accepted.

lass mal das Makro über deine Daten laufen:

Sub umwandeln()

Dim arrB

Dim arrT

Dim z As Long, s As Long, zE As Long

Dim id As String

Dim Abteilungen

Dim Datums

Dim x, y, M

Dim dat

Dim erg



arrB = Sheets("Büro").Cells(1, 1).CurrentRegion

arrT = Sheets("Technik").Cells(1, 1).CurrentRegion



Set Abteilungen = CreateObject("scripting.dictionary")

Set Datums = CreateObject("scripting.dictionary")



For z = 2 To UBound(arrB, 1)

    Abteilungen(arrB(z, 2)) = ""

    If arrB(z, 1) > "" Then Datums(CStr(arrB(z, 1))) = ""

Next

Abteilungen("Technik") = ""



For z = 2 To UBound(arrT, 1)

    If arrT(z, 1) > "" Then Datums(CStr(arrT(z, 1))) = ""

Next



z = 0

For Each x In Datums.keys

    z = z + 1

    Datums(x) = z

Next



s = 0

For Each x In Abteilungen.keys

    s = s + 1

    Abteilungen(x) = s

Next



ReDim erg(1 To z, 1 To s)





For z = 2 To UBound(arrB, 1)

    If arrB(z, 1) > "" Then zE = Datums(CStr(arrB(z, 1)))

    s = Abteilungen(arrB(z, 2))

    erg(zE, s) = erg(zE, s) & arrB(z, 5) & " " & arrB(z, 3) & IIf(arrB(z, 4) = "Ja", " J", "") & "|"

Next

s = Abteilungen("Technik")

For z = 2 To UBound(arrT, 1)

    If arrT(z, 1) > "" Then zE = Datums(CStr(arrT(z, 1)))

    erg(zE, s) = erg(zE, s) & arrT(z, 3) & " " & arrT(z, 2) & "|"

Next



    

      

dat = Datums.keys

    



With Sheets("ziel")

    .Cells.ClearContents

    .Cells(1, 1) = "Datum"

    .Cells(1, 2).Resize(1, Abteilungen.Count) = Abteilungen.keys

    For z = 1 To UBound(erg)

        zE = .Cells.Find(what:="?*", LookIn:=xlFormulas, searchdirection:=xlPrevious, searchorder:=xlByRows).Row + 1

        .Cells(zE, 1).Value = dat(z - 1)

        For s = 1 To UBound(erg, 2)

            M = Split(erg(z, s), "|")

            .Cells(zE, s + 1).Resize(UBound(M), 1) = WorksheetFunction.Transpose(M)

        Next

    Next

End With



End Sub

wenns funktionert, dann überlege dir mal, was du oder deine Firma dann im Gegenzug für mich tun könnt.

Gruß Daniel

Aaaah! Tabelle erstellen mit Index

Forumthread: Aaaah! Tabelle erstellen mit Index

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Aaaah! Tabelle erstellen mit Index

Forumthread: Aaaah! Tabelle erstellen mit Index

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread