Sub Qualistatus()
Dim wksUW As Worksheet
Dim wksMitArb As Worksheet
Dim wksProfil As Worksheet
Dim wksQualistatus As Worksheet
Dim booAdd As Boolean
Dim intUnique As Integer
Dim intJ As Integer
Dim intI As Integer
Set wksUW = ThisWorkbook.Worksheets("Unterweisungsstatus")
Set wksMitArb = Worksheets("MitarbeiterArbeitsplatz")
Set wksProfil = Worksheets("Profil")
Set wksQualistatus = Worksheets("Qualistatus")
intRow = wksUW.Cells(20000, 1).End(xlUp).Row + 1
wksQualistatus.Cells(3, 1).Value = wksUW.Cells(2, 3).Value 'Vorname, erster Wert = einmalig
intUnique = 2 'Erste Zeile = einmalig, deswegen Beginn ab 2
booAdd = True 'Beginn: Boolean wird true gesetzt
For intI = 3 To 40
For intJ = 3 To intUnique
If wksQualistatus.Cells(intJ, 1).Value = wksUW.Cells(intI, 3).Value Then
booAdd = False
End If
Next intJ
If booAdd = True Then
wksQualistatus.Cells(intJ, 1).Value = wksUW.Cells(intUnique + 1, 3).Value
End If
intUnique = intUnique + 1 'Fehler beseitig: Allerdings die leeren Zeilen müssen weg
booAdd = True
Next intI
' wksQualistatus.Cells(intZaehler, 1).Value = wksUW.Cells(intCounter, 2).Value 'Vorname
' wksQualistatus.Cells(intZaehler, 2).Value = wksUW.Cells(intCounter, 3).Value 'Nachname
' End If
' intCounter = intCounter + 1
' intZaehler = intZaehler + 1
' Loop
' Loop
End Sub |