habe ein kleines Problemchen.
Ich habe mir ein Makro gebastelt (mit Hajo hilfe auch), welches mir zwei Tabellen vergleicht und in die dritte die Daten reinschreibt.
Nun möchte ich dass während diesem Vergleich- und Schreibvorgang oder auch danach geprüft, die Anzahl pro Nummer in Splate der in E vorkommen Namen gezählt wird. Unter Berücksichtigung der Tatsache, dass in E pro Nummer der selbe Name doppelt oder dreifach vorkommen kann.
hier ist ein kleiner Auszug aus der Tabelle
https://www.herber.de/bbs/user/21860.xls
und hier das Makro
Sub Test()
Dim LoI As Long
Dim LoJ As Long
Dim LoLetzte1 As Long
Dim LoLetzte2 As Long
Dim Loletzte3 As Long
With Worksheets("1")
LoLetzte1 = IIf(IsEmpty(.Range("h65536")), .Range("h65536").End(xlUp).Row, 65536)
End With
With Worksheets("Tabelle1")
LoLetzte2 = IIf(IsEmpty(.Range("a65536")), .Range("a65536").End(xlUp).Row, 65536)
End With
For LoI = 1 To LoLetzte1
For LoJ = 1 To LoLetzte2
' Leerzellen nicht kennzeichnen
If Worksheets("1").Cells(LoI, 8) <> "" Then
If Worksheets("1").Cells(LoI, 8) = Worksheets("Tabelle1").Cells(LoJ, 1) Then
If Worksheets("1").Cells(LoI, 14) <> "Ausgefallen" Then
If Worksheets("1").Cells(LoI, 14) <> "Abgemeldet" Then
If Worksheets("1").Cells(LoI, 14) <> "Krank" Then
If Worksheets("1").Cells(LoI, 14) <> "Storniert" Then
If Worksheets("2").Cells(LoI, 5) <> "Service" Then
Worksheets("1").Rows(LoI).Copy
With Worksheets("Tabelle3")
Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
If Loletzte3 > 65536 Then
MsgBox "In Tabelle3 ist keine Zeile mehr frei"
Application.CutCopyMode = False
Exit Sub
End If
.Rows(Loletzte3).PasteSpecial Paste:=xlValues ' Werte
.Rows(Loletzte3).PasteSpecial Paste:=xlFormats ' Formate
End With
Exit For ' innere Schleife verlassen da Datensatz gefunden
End If
End If
End If
End If
End If
End If
End If
Next LoJ
Next LoI
Application.CutCopyMode = False
End Sub
Kann man das irgenwie implementieren?
MFG
artur