VBA-Makro in Excel vergleicht nicht richtig.

Avarion

Grünschnabel
Hallo,

leider ärger ich mich jetzt schon seit ein paar Tagen mit Excel rum und finde meinen Fehler nicht.
Ich habe eine CSV-Datei einer Datenbankauswertung importiert und möchte nun ein Makro basteln das mehrmals vorkommende Informationen zusammensortiert.

Im Klartext habe ich eine Angabe von Mitarbeitern und Ihre Funktionen sowie den funktionsunabhängigen Vertretern der Mitarbeiter.

Im Moment sieht das so aus:

MitarbeiterA Funktion1 Vertreter1
MitarbeiterA Funktion1 Vertreter2
MitarbeiterA Funktion2 Vertreter1
MitarbeiterA Funktion2 Vertreter2
MitarbeiterB Funktion1 Vertreter1
MitarbeiterB Funktion2 Vertreter1
MitarbeiterC ...


Aussehen soll es hinterher:

MitarbeiterA Funktion1 Funktion2 Vertreter1 Vertreter2
MitarbeiterB Funktion1 Funktion2 Vertreter1
MitarbeiterC ...

Jeder Mitarbeiter kann 4 Funktionen und 3 Vertreter haben.
Meine Vorgehensweise ist ein Array anzulegen welches schon so aufgebaut ist wie ich hinterher die Daten haben möchte und die Funktionen und Vertreter der ersten Zeile einzulesen. Dann ein zweites Array anzulegen welches nur eine Funktion und ein Vertreter enthält und darin die nächste Zeile einzulesen. Dann wollte ich Testen ob beide den selben Mitarbeiter haben und wenn ja den Inhalt des Arrays2 mit Array1 in einer Schleife zu vergleichen.
Findet er eine Übereinstimmung bei Funktion beendet er die Schleife und testet auf Vertreter. Bei Übereinstimmung auch dort ein Beenden der Schleife. Findet er keine Übereinstimmung übernimmt er in das erste entsprechende freie Feld des Arrays1 den Wert und löscht die Zeile.
Dann beginnt er wieder von vorne mit der nun hochgerutschten Zeile.

Soweit die Theorie. Hier ist mein nicht funktionierender Code. Mein Augenflälliges Problem ist das der Vergleich nicht funktioniert oder aber die Daten nicht in das Array kopiert werden.

Code:
Sub blah()
Dim Q, I, Y, X
Dim ZeilenZahl
Dim Funktionen(4)
Dim Vertreter(4)
Dim Cursor
Dim Funktion, Vertret
Dim POS1, POS2
Dim MATCH
Dim PosUnten, PosOben, FunkVerSchalt

MATCH = 0
Q = 0
X = 1

'ZeilenZahl = Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Debug.Print Zeilenzahl

Range("A2").Select

Do While X < 5
    X = X + 1
    Range("A" & X).Select
    POS1 = ActiveCell.Offset
    Y = X + 1
    Range("A" & Y).Select
    POS2 = ActiveCell.Offset
    If POS1 = POS2 Then
        'Erste Zeile einlesen
        Range("K" & X).Select
        Funktionen(0) = ActiveCell.Offset
        Range("T" & X).Select
        Funktionen(1) = ActiveCell.Offset
        Range("U" & X).Select
        Funktionen(2) = ActiveCell.Offset
        Range("V" & X).Select
        Funktionen(3) = ActiveCell.Offset
        Range("M" & X).Select
        Vertreter(0) = ActiveCell.Offset
        Range("W" & X).Select
        Vertreter(1) = ActiveCell.Offset
        Range("X" & X).Select
        Vertreter(2) = ActiveCell.Offset
        Range("Y" & X).Select
        Vertreter(3) = ActiveCell.Offset
        
        'Zweite Zeile einlesen
        Range("K" & Y).Select
        Funktion = ActiveCell.Offset
        Range("M" & Y).Select
        Vertret = ActiveCell.Offset
                
        'Vergleichen
        '--- Funktionen
        For PosOben = 0 To 3
            If PosOben = "" Then
                Funktionen(PosOben) = Funktion
            End If
        Next PosOben
        '--- Vertreter
        For PosOben = 0 To 3
            If PosOben = "" Then
                Vertreter(PosOben) = Vertret
            End If
        Next PosOben
    Else
        'Array zurückschreiben
        Range("T" & X) = Funktionen(1)
        Range("U" & X) = Funktionen(2)
        Range("V" & X) = Funktionen(3)
        Range("W" & X) = Vertreter(1)
        Range("X" & X) = Vertreter(2)
        Range("Y" & X) = Vertreter(3)
    End If
Loop

End Sub

Wenn jemand eine Idee hat oder noch Infos braucht bitte melden. Ich bin langsam mit den Nerven am Ende :rolleyes:
 

Neue Beiträge

Zurück