Mehrere Spaltenwerte in Zeile übertragen
14.04.2017 10:45:59
Christian
auch an Ostern beschäftigen mich meine VBA Herausforderungen und leider klomme ich nicht weiter.
Ich habe versucht das Problem und meinen aktuellen Code so detailiert wie möglich zu gestalten und hoffe sehr auf Ideen, Vorschläge, Tipps....
Problem:
In der Tabelle tblGrafik die Spalte (2) MSN mit der Spalte in der Tabelle tblPlanung Spalte (2) MSN abgleichen. Bei einer Übereinstimmung, die Zeile "einfrieren" und ab da als Referenzlinie verwenden. Jetzt sollen bestimmte Spaltenwerte "Datumswerte" in tblPlanung in die Zeile von Tabelle tblGrafik eingefügt werden.
In der Tabelle tblGrafik ist eine Datumsachse in Zeille (3) und in tblPlanung sind bestimmte Datumswerte. Die Datumswerte sollen in tblGrafik übertragen werden.
Code:
Option Explicit
Private Sub Datumsabgleich()
'Feldbezeichnungen
'TA-1, TA-2, TA-3, TA-4, TA-5 = ColorIndex 22
'brt-1, brt-2, brt-3, brt-4, brt-5 = ColorIndex 17
'CF-1, CF-Start, CF-3, CF-4, CF-5 = ColorIndex 36
Dim i As Integer 'Zeile Grafik
Dim j As Integer 'Zeile Planung (Datenbasis)
Dim k As Integer 'Spalten variable für tblPlanung
Dim m As Long ' gefundene Zeile zwischen speichern
For i = 6 To 33 'Alle MSN in der tblGrafik durchgehen
For j = 2 To 34 'Alle MSN in der tblPlanung durchgehen
If tblGrafik(i, 2) = tblPlanung(j, 2) Then 'Abgleich MSN Spalte 2 in tblGrafik, Spalte 2 in _
tblPlanung
m = tbl.Planung(j, Rows.Column.Count).End(xlToLeft).Row + 1 'Die gefundene Zeile merken
Else
End If
Next j
Next i
If tblGrafik(3, d) = tbPlanung(m, j) Then 'für die bestimmte MSN in der jeweiligen Zeile
With tblPlanung
'Alle unten aufgeführten Spaltenwerte für die jeweilige MSN zwischen speichern und später _
in tblGrafik einfügen
End With
With tblGrafik
'Die Zellen merken
.Cells(i, 4).Value = "TA-1"
.Cells(i, 4).Interior.ColorIndex = 22
.Cells(i, 8).Value = "TA-2"
.Cells(i, 8).Interior.ColorIndex = 22
.Cells(i, 12).Value = "TA-3"
.Cells(i, 12).Interior.ColorIndex = 22
.Cells(i, 16).Value = "TA-4"
.Cells(i, 16).Interior.ColorIndex = 22
.Cells(i, 20).Value = "TA-5"
.Cells(i, 20).Interior.ColorIndex = 22
.Cells(i, 5).Value = "BRT-1"
.Cells(i, 5).Interior.ColorIndex = 17
.Cells(i, 9).Value = "BRT-2"
.Cells(i, 9).Interior.ColorIndex = 17
.Cells(i, 13).Value = "BRT-3"
.Cells(i, 13).Interior.ColorIndex = 17
.Cells(i, 17).Value = "BRT-4"
.Cells(i, 17).Interior.ColorIndex = 17
.Cells(i, 21).Value = "BRT-5"
.Cells(i, 21).Interior.ColorIndex = 17
.Cells(i, 6).Value = "CF-1"
.Cells(i, 6).Interior.ColorIndex = 36
.Cells(i, 10).Value = "CF-Start"
.Cells(i, 10).Interior.ColorIndex = 36
.Cells(i, 14).Value = "CF-3"
.Cells(i, 14).Interior.ColorIndex = 36
.Cells(i, 18).Value = "CF-4"
.Cells(i, 18).Interior.ColorIndex = 36
.Cells(i, 22).Value = "CF-5"
.Cells(i, 22).Interior.ColorIndex = 36
End With
Next j
Next i
End Sub
Ich weiss sehr wohl, das ich hier sehr viel vom Forum erwarte. A sich überhaupt in das Problem einzudenken und B Lösungsvorschläge zu generien. Aber ich hoffe ihr seht das mich das Problem sehr beschäftigt und ich daran bin das zu erarbeiten aber ich komme einfach im Moment nicht weiter..
Vielen Dank für eure Bemühungen
Anbei die Beispieldatei
https://www.herber.de/bbs/user/112876.xlsm
Viele Grüße
Christian