Gleiche Werte von zwei Spalten in gleiche Zeile

Servus zusammen.
Ich benötige einen VBA Code zum Sortieren gleicher Werte mit Text in dieselbe Zeile.
Hierzu erstmal ein Bild:
Userbild

Die Übersicht vom Dezember 2016 soll unberührt bleiben.
Im Juli 2017 soll das Makro so funktionieren dass es alle 3 Spalten (Maschinennummer, Investition und Beschreibung) in die Zeilen sortiert wo auch die Maschinennummer im Dezember 2016 steht.
So, dass zum Beispiel die Maschinennummern 9932 und 9932 in der selben Zeile stehen und man somit den direkten Vergleich beider Investitionen sieht.
Außerdem soll im Juli 2017 für die Maschinennummer 1111 die Zelle rot eingefärbt werden, weil sie ja da in der Spalte fehlt.
Ich würde das gerne in VBA selbst programmieren aber soweit reichen meine Kenntnisse dann doch nicht.
Danke schonmal :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo watsonenge,
im nachfolgenden Makro muss du noch Anpassungen bzgl. der Spalten- und Zeilen-Nummern machen.
Gruß
Franz

Sub SortMaschinen()
Dim wks As Worksheet
Dim Spa_VJ As Long, Spa_J As Long
Dim Zei_1 As Long, Zei_L As Long, Zei_VJ As Long, Zei_J As Long
Dim arrData_J
Dim varMaschNr As Variant
Set wks = ActiveSheet
'die nachfolgenden Werte ggf. anpassen
Spa_VJ = 1          'Spalte mit Maschinen-Nr des Vorjahres
Spa_J = Spa_VJ + 3  'Spalte mit Maschinen-Nr des aktuellen Jahres
Zei_1 = 4           'Zeile mit 1. Maschinen-Nr. unter den Spaltentiteln
With wks
'letzte Zeile mit Masch.-Nr im Vorjahr
Zei_L = .Cells(.Rows.Count, Spa_VJ).End(xlUp).Row
'Daten des laufenden Jahres in Array laden
arrData_J = .Range(.Cells(Zei_1, Spa_J), .Cells(Zei_L, Spa_J + 2))
'Daten des laufenden Jahres löschen
.Range(.Cells(Zei_1, Spa_J), .Cells(Zei_L, Spa_J + 2)).ClearContents
'letzte Zeile mit Masch.-Nr im Vorjahr
Zei_L = .Cells(.Rows.Count, Spa_VJ).End(xlUp).Row
'Nummern im laufenden Jahr sortieren
For Zei_VJ = Zei_1 To Zei_L
varMaschNr = .Cells(Zei_VJ, Spa_VJ).Value
For Zei_J = LBound(arrData_J, 1) To UBound(arrData_J, 1)
If arrData_J(Zei_J, 1) = varMaschNr Then
.Cells(Zei_VJ, Spa_J) = varMaschNr
.Cells(Zei_VJ, Spa_J + 1) = arrData_J(Zei_J, 2)
.Cells(Zei_VJ, Spa_J + 2) = arrData_J(Zei_J, 3)
arrData_J(Zei_J, 1) = ""
Exit For
End If
Next Zei_J
Next Zei_VJ
'fehlende Nrn. markieren
For Zei_VJ = Zei_1 To Zei_L
If .Cells(Zei_VJ, Spa_J) = "" Then
.Cells(Zei_VJ, Spa_J).Interior.Color = RGB(255, 0, 0)
End If
Next Zei_VJ
'im Vorjahr nicht vorhandene Masch.Nrn. im laufenden Jahr nachtragen
For Zei_J = LBound(arrData_J, 1) To UBound(arrData_J, 1)
If arrData_J(Zei_J, 1)  "" Then
Zei_L = Zei_L + 1
.Cells(Zei_L, Spa_J) = arrData_J(Zei_J, 1)
.Cells(Zei_L, Spa_J + 1) = arrData_J(Zei_J, 2)
.Cells(Zei_L, Spa_J + 2) = arrData_J(Zei_J, 3)
End If
Next Zei_J
End With 'wks
End Sub

'Nummern im laufenden Jahr sortieren For Zei_VJ = Zei_1 To Zei_L varMaschNr = .Cells(Zei_VJ, Spa_VJ).Value For Zei_J = LBound(arrData_J, 1) To UBound(arrData_J, 1) If arrData_J(Zei_J, 1) = varMaschNr Then .Cells(Zei_VJ, Spa_J) = varMaschNr .Cells(Zei_VJ, Spa_J + 1) = arrData_J(Zei_J, 2) .Cells(Zei_VJ, Spa_J + 2) = arrData_J(Zei_J, 3) arrData_J(Zei_J, 1) = "" Exit For End If If Zei_J = UBound(arrData_J, 1) Then Zei_L = Zei_L + 1 .Cells(Zei_L, Spa_J) = .Cells(Zei_VJ, Spa_VJ) .Cells(Zei_L, Spa_J + 1) = .Cells(Zei_VJ, Spa_VJ + 1) .Cells(Zei_L, Spa_J + 2) = .Cells(Zei_VJ, Spa_VJ + 2) End If Next Zei_J Next Zei_VJ

Beliebteste Forumthreads (12 Monate)

Gleiche Werte von zwei Spalten in gleiche Zeile

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

320 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Gleiche Werte von zwei Spalten in gleiche Zeile

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

320 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread