VBA - Zuweisung von Daten aus mehreren Tabellenblättern

[marinko]

Hallo,

ich habe ein Makro erstellt - komme bei diesem Punkt einfach nicht weiter:

Makro: In Tabellenblatt "Output" (und auch VBA Modul Output) werden Kursteilnehmer zu Kursen zugewiesen.
Jeder Kurs hat gewisse Zielgruppen (Tabellenblatt "Options" - Spalte G).

Wenn ich jetzt ein Training hinzufüge (Tabellenblatt "Trainings") - Button "Add Training" dann sollen die Trainings in das Tabellenblatt geschrieben werden.
Das passt.

Danach waere vorgesehen, dass die Mitarbeiter zu den Kursen hinzugefügt werden.
Derzeit es ist nicht ganz richtig, weil meine Logik nicht funktioniert:

Bsp:
G-B-Local-CTO Kick-Off hat als Target Group: Plant Manager, Production Manager,...
Mitarbeiter haben diese Rollen im Tabellenblatt Employees hinterlegt.

Wenn jetzt Mitarbeiter einer Schicht zugewiesen sind (Tabellenblatt: "Employees") zB EBM A und als Nebenrolle Production Manager - dann werden diese aktuell nicht ausgelesen - und das ist falsch.
Ich würde gerne diese Mitarbeiter auch haben. Ist das überhaupt möglich mit meiner Logik?

Hier die Logik:

Code:

Sub Test()
   Dim A As Integer
   Dim B As Integer
   Dim C As Integer
   Dim d As Integer
   Dim e As Integer
   Dim Position As Integer
           Position = ActiveWorkbook.Sheets("output").UsedRange.Rows.Count
           
   'Inhalt leeren
   ActiveWorkbook.Sheets("Output").Range("A2:H100000").ClearContents
   Position = 2
   
   'Zellposition suchen
   For A = 17 To ActiveWorkbook.Sheets("Trainings").UsedRange.Rows.Count
   
       'Spaltenposition suchen Training Tab Trainings Training
       Dim trainingName As String
       trainingName = ActiveWorkbook.Sheets("Trainings").Cells(A, 8).Value
       
       Dim date2 As Date
           date2 = ActiveWorkbook.Sheets("Trainings").Cells(A, 10)
           
       Dim Duration As Single
           Duration = ActiveWorkbook.Sheets("Trainings").Cells(A, 12)
           
       Dim aduration As Single
           aduration = ActiveWorkbook.Sheets("Trainings").Cells(A, 16)
       
       'Spaltenposition suchen Shift Tab Trainings Shift
       Dim shifttraining As String
       shifttraining = ActiveWorkbook.Sheets("Trainings").Cells(A, 13).Value
       
       'Ausstieg bei keiner Übereinstimmung
       If (trainingName = "") Then
         GoTo LBLand
       End If
         
       For B = 7 To ActiveWorkbook.Sheets("Options").UsedRange.Rows.Count
       Dim trainingName2 As String
       'Startposition für Trainingsname
       trainingName2 = ActiveWorkbook.Sheets("Options").Cells(B, 1).Value
       
       'Vergleich Training aus Tab Trainings und Options
       If (trainingName = trainingName2) Then
     
     
           Dim rolename As String
           'Startposition für Rolename im Options
           rolename = ActiveWorkbook.Sheets("options").Cells(B, 7).Value
           
               Dim rolenamearr() As String
               'Split von Rolename
               rolenamearr = Split(rolename, ",", , vbTextCompare)
               
           'Startposition für Tab Employees
           For C = 9 To ActiveWorkbook.Sheets("Employees").UsedRange.Rows.Count
           Dim rolename2 As String
           'Startposition für Rolename
           rolename2 = ActiveWorkbook.Sheets("Employees").Cells(C, 6)

           
           Dim rolename3 As String
           rolename3 = ActiveWorkbook.Sheets("Employees").Cells(C, 7)
           
           
           Dim EmployeeName As String
           'Startposition für Name
           EmployeeName = ActiveWorkbook.Sheets("Employees").Cells(C, 3)
           
           Dim EmployeeName2 As String
           EmployeeName2 = ActiveWorkbook.Sheets("Employees").Cells(C, 4)
           
           Dim Mainrole As String
           Mainrole = ActiveWorkbook.Sheets("Employees").Cells(C, 6)
           
           'Startposition für Shift
           Dim shift As String
           shift = ActiveWorkbook.Sheets("Employees").Cells(C, 5)
           
           'Vergleich von Shift Tab Employees and Training
           Dim foundshift As Boolean
           foundshift = False
           If Replace(shift, "-", "") = Replace(shifttraining, "-", "") Then
           foundshift = True
           End If
           
           Dim Found As Boolean
           Found = False
           
           'Vergleich von Rolename Tab Options and Employees
           For d = 0 To UBound(rolenamearr)
           If (Replace(Replace(Trim(rolenamearr(d)), Chr(10), ""), " ", "") = Replace(Replace(Trim(rolename2), " ", ""), Chr(10), "")) Then
           
           Found = True
           
           End If
           
           Next d
           
            For e = 0 To UBound(rolenamearr)
           If (Replace(Replace(Trim(rolenamearr(e)), Chr(10), ""), " ", "") = Replace(Replace(Trim(rolename3), " ", ""), Chr(10), "")) Then
           
           Found = True
           
           End If
           
           Next e
           
           'Ausgabe in Tabellenblatt Output
               If (Found And foundshift) Then
     
         
                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 1).Value = date2
                   
                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 2).Value = trainingName
                                     
                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 3).Value = EmployeeName
                   
                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 4).Value = EmployeeName2
                   
                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 5).Value = shift
                   
                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 6).Value = Mainrole

                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 7).Value = Duration
                   
                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 8).Value = aduration
                   
                   ActiveWorkbook.Sheets("Output").Cells(Position + 1, 9).Value = 1
                   
               
                   
           Position = Position + 1
           
   '            GoTo LBLnextA:
     
               End If
     
     
           Next C
     
     
     
     
     
     
     
       
       End If
       
       
       
       Next B
LBLnextA:
   Next A

   

LBLand:


End Sub

Ich habe in Spalte P in Tabellenblatt "Output" die Lösung der Namen hingeschrieben welche noch fehlen.


Vielen Dank schon mal vorab...

Das ganze Problem ist echt schwer zu beschreiben - es hilft wenn man sich die Tabellenstruktur im Excel ansieht.

lg,
Marinko

[marinko]

Ich weiß es ist sehr kompliziert beschrieben, aber gibt es einen Spezialisten der sich im Bereich VBA auskennt?

Das ware super! Auch wenn man die Excel file öffnet, dann werden die ganzen Sachen ein wenig klarer... Stehe gerne für Rückfragen bereit.

Vielen lieben Dank!

lg, Marinko

[schauan]

Hallöchen,

Du könntest z.B. mal in den Zeilen, wo Du Found und FoundShift ermittelst, Haltepunkte setzen und schauen, ob Dir das Ergebnis zusagt. Übertragen tust Du ja unter der Bedingung Found And FoundShift, also sollte beides True sein. Wenn das nicht passt, müsstest Du wahrscheinlich in einer der 3 Zeilen schrauben ... Hab jetzt nur mal schnell den geposteten Code überflogen.