Knifflige Aufgabe für VBA

Hallo zusammen
Ich muss aus einem Datensatz für eine Priorisierung einen Auszug erstellen.
Zum besseren Verständnis habe ich euch eine vereinfachte Musterdatei erstellt.
Aufgabe:
Im Blatt Datensatz muss je innerhalb der Zeilen Name 1, dann Name 2, usw. aus Spalte D die höchste Priorisierung (Zahlen 1 bis 4) definiert werden und anschliessend bei mehreren gleichen Priorisierungen, also bei zwei 4, die Zeile mit der kleinsten Jahreszahl definiert und in Blatt Auszug kopiert werden.
Zur Veranschaulichung habe ich in Spalte F mit einem x bezeichnet, welche Zeilenangaben übernommen werden müssen. In der Originaldatei fehlen natürlich die Angaben mit x. Jahreszahlen und Prio ändern, weshalb diese Auszüge nur automatisiert vorgenommen werden können.
Wie kann ich das mit VBA lösen?
https://www.herber.de/bbs/user/64529.xls
Vielen Dank und Gruss
Gregor

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Gregor,
hier mein Lösungsvorschlag
Gruß
Franz

Sub Auszug()
Dim wksAuszug As Worksheet, wksData As Worksheet
Dim ZeileData As Long, ZeileAuszug As Long, bolNewTop As Boolean
Dim strName As String, Element As String, Jahr As Long, Prioritaet As Long
Set wksData = Worksheets("Datensatz")
Set wksAuszug = Worksheets("Auszug")
With wksAuszug
'Altdatenlöschen im Auszug
.Range(.Cells(2, 1), .Cells(2, 1).End(xlDown).Offset(0, 3)).ClearContents
ZeileAuszug = 1
End With
With wksData
For ZeileData = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
If Not IsEmpty(.Cells(ZeileData, 1)) Then
'Neuer name, Daten in Auszug übertragen
If strName  "" Then
With wksAuszug
ZeileAuszug = ZeileAuszug + 1
.Cells(ZeileAuszug, 1) = strName
.Cells(ZeileAuszug, 2) = Element
.Cells(ZeileAuszug, 3) = Jahr
.Cells(ZeileAuszug, 4) = Prioritaet
End With
End If
strName = .Cells(ZeileData, 1)
Element = .Cells(ZeileData, 2)
Jahr = .Cells(ZeileData, 3)
Prioritaet = .Cells(ZeileData, 4)
Else
If Prioritaet  .Cells(ZeileData, 3) Then
bolNewTop = True
Else
bolNewTop = False
End If
If bolNewTop = True Then
Element = .Cells(ZeileData, 2)
Jahr = .Cells(ZeileData, 3)
Prioritaet = .Cells(ZeileData, 4)
End If
End If
Next ZeileData
If strName  "" Then
With wksAuszug
ZeileAuszug = ZeileAuszug + 1
.Cells(ZeileAuszug, 1) = strName
.Cells(ZeileAuszug, 2) = Element
.Cells(ZeileAuszug, 3) = Jahr
.Cells(ZeileAuszug, 4) = Prioritaet
End With
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread