PDA

Vollständige Version anzeigen : VBA - Zellen neu zuordnen nach Änderung durch Indirekt-Anweisung


anni87
30.06.2014, 09:44
Guten Morgen,

Ich habe eine Tabelle mit zwei Tabellenblättern. Die Daten aus dem Blatt 2 (Kurse) sollen in Blatt1 (Übersicht) übernommen werden. Die Kurse stehen in Blatt 2 Spalte A und erscheinen nach einer Aktualisierung des Blattes 1 auch dort Spalte A. Dieses geht auch über: Zelle aus Blatt1 SpalteA=Indirekt("'Teil 2'!A6")

Nun werden noch die KLurszeiten aus dem Blatt2 in das Blatt1 übernommen und die Zellen werden rot dargestellt.

Alles auswählen
Sub Daten_übertragen_aus_Teil2()

Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Dim Zeile As Long
Dim Spalte As Long
Dim blaueZelle As Range
Dim Zeile2 As Long
Dim Spalte2 As Long
Dim Zeile3 As Long
Dim Spalte3 As Long
Dim rngErgebnis As Range
Dim rngErgebnis3 As Range

Set Tab1 = Worksheets("Teil 1_Kursliste")
Set Tab2 = Worksheets("Teil 2_Kursorte+Ansprechpartner")


'Termine übernehmen

'rote Zellen löschen
For Spalte = 3 To 144
For Zeile = 8 To 88

If Tab1.Cells(Zeile, Spalte).Interior.Color = vbRed Then
Tab1.Cells(Zeile, Spalte).Clear
End If
Next
Next

'Wochenende löschen
For Each blaueZelle In Tab1.Range("C8:EN88") 'Für jede volleZelle im Bereich("B4:O40")wird die Anweisung wiederholt
If blaueZelle.Interior.ColorIndex = 37 Then 'Prüfung ob Zelle blau, wenn ja dann
blaueZelle.Interior.Color = xlNone
End If
Next blaueZelle

'gefundene Zellen rot färben nach Abfrage
For Spalte = 3 To 144
For Zeile = 8 To 88

'Wenn keine Zellen in Zeile farbig

If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Tab2.Cells(Zeile - 2, 3) = Tab1.Cells(7, Spalte) Then
If Tab1.Cells(Zeile, Spalte).Interior.ColorIndex = xlNone Then
Tab1.Cells(Zeile, Spalte).Interior.Color = vbRed
End If
End If
End If
Next Zeile
Next

For Spalte = 3 To 144
For Zeile = 8 To 88


If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Tab2.Cells(Zeile - 2, 5) = Tab1.Cells(7, Spalte) Then
If Tab1.Cells(Zeile, Spalte).Interior.ColorIndex = xlNone Then
Tab1.Cells(Zeile, Spalte).Interior.Color = vbRed
Else
End If
End If
End If
Next Zeile
Next

'Wochenende neu
Call Wochenende_farbig


End Sub



Wenn ich nun einen neue Zeile (neuen Kurs) in Blatt2 eingebe, wird diese in Blatt1 übernommen, aber die alten farbigen Zellen (von den Zeilen in Blatt1 unter dem neuen Kurs) bleiben farbig und sind dann falsch zugeordnet.

Ich habe eine Datei als Beispiel mit angehangen und hoffe dass mein Problem anhand der Datei deutlich wird... (das beschreiben finde ich ziemlich schwer)

Kann ich den oberen Code so umprogrammieren, dass die Farbe der unteren Zeilen, um eine Zeile verschoben wird?

Oder kann ich wieder einen Zellenvergleich einfügen? zum Beispiel:

'Prüfung ob Zelle noch farbig sein darf
For Each farbigeZelle In Tab1.Range("C8:EN88")
If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Tab2.Cells(Zeile - 2, 3) <> Tab1.Cells(7, Spalte) Then
farbigeZelle.Interior.Color = xlNone
End If
End If
Next farbigeZelle

Nur werden bei diesem die farbigenZellen nicht gelöscht

Liebe Grüße

anni87

Hasso
30.06.2014, 10:06
Hallo Anni,

versuch malfarbigeZelle.Interior.ColorIndex = xlNone

(Hatte Hajo, glaube ich, vor einiger Zeit auch schon mal gepostet. Bin mir nicht sicher, ob das bei dir war)

anni87
30.06.2014, 10:08
Hallo Hasso,

das geht leider nicht...

Kann es an meinen Vergleich
If Tab2.Cells(Zeile - 2, 3) <> Tab1.Cells(7, Spalte) Then

mit dem "<>" liegen?

Hasso
30.06.2014, 10:21
Hallo Anni,

könntest du mal die neueste Version deiner Mappe hochladen, denn den Code'Prüfung ob Zelle noch farbig sein darf
For Each farbigeZelle In Tab1.Range("C8:EN88")
If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Tab2.Cells(Zeile - 2, 3) <> Tab1.Cells(7, Spalte) Then
farbigeZelle.Interior.Color = xlNone
End If
End If
Next farbigeZellefinde ich in deiner Beispielmappe nicht.

anni87
30.06.2014, 10:24
Ja, klar... hier ist sie...

da mir die idee erst nach dem Hochladen kam, hier eine neue Version der Tabelle

Ich habe an der Idee/ dem Code noch weiter rumprobiert. Sieht nun so aus:

'Prüfung ob Zelle noch farbig sein darf
For Each farbigeZelle In Tab1.Range("C8:EN88")
If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Not Tab2.Cells(Zeile - 2, 3) = Tab1.Cells(7, Spalte) Then
farbigeZelle.Clear
End If
End If
Next farbigeZelle

anni87
30.06.2014, 10:55
Ok, der erste Fahler war die Zellen und Spaltenzuweisung fehlte... Nun passiert immer etwas bei dem Code, aber leider werden alle Zellfarben gelöscht...

*Leicht verzweifelt*

Sub Daten_übertragen_aus_Teil2()

Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Dim Zeile As Long
Dim Spalte As Long
Dim blaueZelle As Range
Dim farbigeZelle As Range
Dim Zeile2 As Long
Dim Spalte2 As Long
Dim Zeile3 As Long
Dim Spalte3 As Long
Dim rngErgebnis As Range
Dim rngErgebnis3 As Range

Set Tab1 = Worksheets("Teil 1_Kursliste")
Set Tab2 = Worksheets("Teil 2_Kursorte+Ansprechpartner")


'Termine übernehmen

'rote Zellen löschen
For Spalte = 3 To 144
For Zeile = 8 To 88

If Tab1.Cells(Zeile, Spalte).Interior.Color = vbRed Then
Tab1.Cells(Zeile, Spalte).Clear
End If
Next
Next

'Wochenende löschen
For Each blaueZelle In Tab1.Range("C8:EN88") 'Für jede volleZelle im Bereich("B4:O40")wird die Anweisung wiederholt
If blaueZelle.Interior.ColorIndex = 37 Then 'Prüfung ob Zelle blau, wenn ja dann
blaueZelle.Interior.Color = xlNone
End If
Next blaueZelle

'Prüfung ob Zelle noch farbig sein darf
For Spalte = 3 To 144
For Zeile = 8 To 88

For Each farbigeZelle In Tab1.Range("C8:EN88")
If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Tab2.Cells(Zeile - 2, 3) <> Tab1.Cells(7, Spalte) Then
Tab1.Cells(Zeile, Spalte).Interior.Color = xlNone
End If
End If
Next farbigeZelle

Next Zeile
Next

'gefundene Zellen rot färben nach Abfrage
For Spalte = 3 To 144
For Zeile = 8 To 88

'Wenn keine Zellen in Zeile farbig

If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Tab2.Cells(Zeile - 2, 3) = Tab1.Cells(7, Spalte) Then
If Tab1.Cells(Zeile, Spalte).Interior.ColorIndex = xlNone Then
Tab1.Cells(Zeile, Spalte).Interior.Color = vbRed
End If
End If
End If
Next Zeile
Next

For Spalte = 3 To 144
For Zeile = 8 To 88


If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Tab2.Cells(Zeile - 2, 5) = Tab1.Cells(7, Spalte) Then
If Tab1.Cells(Zeile, Spalte).Interior.ColorIndex = xlNone Then
Tab1.Cells(Zeile, Spalte).Interior.Color = vbRed
Else
End If
End If
End If
Next Zeile
Next

End Sub

Hasso
30.06.2014, 11:00
Hallo Anni'Prüfung ob Zelle noch farbig sein darf
For Each farbigeZelle In Tab1.Range("C8:EN88")
If Tab2.Cells(Zeile - 2, 1) = Tab1.Cells(Zeile, 1) Then
If Not Tab2.Cells(Zeile - 2, 3) = Tab1.Cells(7, Spalte) Then
farbigeZelle.Clear
End If
End If
Next farbigeZelle
Sind denn das die richtigen Werte?

NachFor Spalte = 3 To 144
For Zeile = 8 To 88
If Tab1.Cells(Zeile, Spalte).Interior.Color = vbRed Then
Tab1.Cells(Zeile, Spalte).Clear
End If
Next
Next
lauten die Werte für Zeile: 89 und für Spalte: 145. Willst du wirklich bei jedem Durchlauf der For-Each-Schleife die Zellen A143 und A145 bzw. C143 und CK143 vergleichen?
Oder meinst du'Prüfung ob Zelle noch farbig sein darf
For Each farbigeZelle In Tab1.Range("C8:EN88")
If Tab2.Cells(farbigeZelle.Row - 2, 1) = Tab1.Cells(farbigeZelle.Row, 1) Then
If Not Tab2.Cells(farbigeZelle.Row - 2, 3) = Tab1.Cells(7, farbigeZelle.Column) Then
farbigeZelle.Clear
End If
End If
Next farbigeZelle

anni87
30.06.2014, 11:49
Hey Hasso,

ich meinte deinen letzten Code...

Kann ich nun noch definieren, dass in Zeilen für welche der Code:

If Not Tab2.Cells(farbigeZelle.Row - 2, 3) = Tab1.Cells(7, farbigeZelle.Column) Then
FALSCH ist, die Zellen nicht gelöscht werden.

Lieben Gruß Anni87

Hasso
30.06.2014, 11:57
Hallo Anni,

es fällt mir wirklich schwer zu verstehen, was du meinst. Wenn die betreffenden Zellen nicht gelöscht werden sollen, dann schreib doch in die erste Bedingung um:'Prüfung ob Zelle noch farbig sein darf
For Each farbigeZelle In Tab1.Range("C8:EN88")
If Tab2.Cells(farbigeZelle.Row - 2, 1) = Tab1.Cells(farbigeZelle.Row, 1) And Tab2.Cells(farbigeZelle.Row - 2, 3) <> Tab1.Cells(7, farbigeZelle.Column) Then
farbigeZelle.Clear
End If
Next farbigeZelle
Ich bin mir aber nicht sicher, ob ich verstanden habe, was du da möchtest.

anni87
30.06.2014, 12:07
Es sollen nur farbige Zellen in den Zeilen gelöscht werden, in welchen die Vergleiche nicht mehr übereinstimmen.

Dieses ist zum Beispiel bei dem Kurs "Dieselgeneratoren Scania" der Fall. In Teil2 sind hier noch keine Daten vorhanden und diese sollen nun im Teil1 gelöscht werden.

Kurse wie "Icebreaker-Party" oder "Einführungsseminar" sollen weiter farbig bleiben...

Sorry dass es so unklar ist

Hasso
30.06.2014, 12:28
Hallo Anni,

deine For-Each-Schleifen führen dazu, dass das ganze Makro recht lange läuft und sehr unübersichtlich ist (zumindest für mich).

Warum clearst du nicht erst alle Zellen in Blatt 1 im Bereich C8:EN88 und trägst dann nur die relevanten Werte aus Blatt 2 in Blatt 1 ein und formatierst die Zellen entsprechend?

anni87
01.07.2014, 08:58
Hallo Hasso,

ich möchte die Zellen, wenn diese nicht rot sind, weiter farbig behalten, da die Kurse feststehen...

Dieses sollen nicht nach jeder Aktualisierung wieder manuell in die richtige Farbe umgewandelt und das Start- und Enddatum verbunden werden.

Lieben Gruß

Anni87