Office: (Office 2016) VBA wenn Spalte Grün überspringen

Hallo Zusammen,

ich hoffe es kann mir noch mal Jemand helfen :-)

ich habe diesen Code in meiner Liste eingetragen, funktioniert auch soweit alles super.

Code:

Sub SVERWEIS_aus_Shoppingcart_aus_EVO()
Debug.Print Now

Dim i As Long, letzteZeile As Long
Dim Arbeitsmappe As Workbook
Dim Datenbasis As Worksheet
Dim Ziel As Worksheet
Dim Bereich As Range
Dim ZelleFirma As Range
Dim WsF As WorksheetFunction

Set Arbeitsmappe = ThisWorkbook
Set Datenbasis = Arbeitsmappe.Worksheets("Shoppingcart_aus_EVO")
Set Ziel = Arbeitsmappe.Worksheets("Arbeitsliste")

letzteZeile = Datenbasis.Range("K" & Rows.Count).End(xlUp).Row

Set Bereich = Datenbasis.Range("A1:W" & letzteZeile)
Set WsF = Application.WorksheetFunction

For i = 2 To Ziel.Range("K" & Rows.Count).End(xlUp).Row
    On Error Resume Next
    Ziel.Range("F" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 2, False)
     Ziel.Range("C" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 23, False)
     Ziel.Range("J" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 10, False)
     Ziel.Range("L" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 5, False)
     Ziel.Range("O" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 20, False)
     Ziel.Range("N" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 4, False)
    Ziel.Range("G" & i).Value = "DG"
    
Next i

Debug.Print Now
End Sub

Nun möchte ich aber das er wenn die Spalte F Grün gefärbt ist, das er die ganze Zeile dann einfach überspringt, da sich dann an den Daten nichts mehr verändern wird. Ist das machbar?

Vielen Dank und viele Grüße

 

Hi,

wie wird die Zellfärbung ausgelöst - durch bedingte Formatierung oder direkte Zellfärbung?

Bis später,
Karin

 

durch bedingte Formatierung :-)

 

Nach diesem Prinzip (ungetestet da Mappe nicht vorliegt):

Code:

For i = 2 To Ziel.Range("K" & Rows.Count).End(xlUp).Row
'    On Error Resume Next
    If Ziel.Range("F" & i).DisplayFormat.Interior.Color <> 1 Then '<== anstelle 1 die Colorfarbe setzen die als erfällte Bedingung gilt
        Ziel.Range("F" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 2, False)
        Ziel.Range("C" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 23, False)
        Ziel.Range("J" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 10, False)
        Ziel.Range("L" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 5, False)
        Ziel.Range("O" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 20, False)
        Ziel.Range("N" & i).Value = WsF.VLookup(Ziel.Range("K" & i).Value, Bereich, 4, False)
        Ziel.Range("G" & i).Value = "DG"
    End If
Next i

Bis später,
Karin

 

erst mal tausend Dank, irgendwie geht es nicht :-( ich hänge die Datei mal mit an :-)

 

Und wo ist die Mappe?

Bis später,
Karin

 

oh nein er hat sie nicht mit angehangen :-( Es sind natürlich nur ein par Testdaten drin, normal sind es mehr Datensätze :-)

 

Du hast geschrieben, dass dein Ursprungscode funktioniert, nur dass du ihn modifiziert haben möchtest. Aber - er macht schon erst einmal gar nichts in deiner hochgeladenen Mappe, weil keiner der Werte aus Spalte K der Datenbasis in der Zieltabelle gefunden wird. Außerdem hat Spalte F keine erfüllte Bedingung mit der Farbe Grün, die die Basis für meinen Code bildet.
Dass mein Code nicht wirkt liegt also nicht am Code selbst sondern daran, dass er in deiner Mappe nichts bewirken kann.

Übrigens: wenn du eine Mappe für eine VBA-Lösung hochlädst, sollte es schon auch eine Mappe mit deinem Code sein und keine xlsx-Datei...

Bis später,
Karin

 

Guten Morgen,

du hast Recht durch das kürzen der Daten hatte ich nicht darauf geachtet, daher habe ich nun mal welche angepasst, wo es erkennbar ist das der Code schon arbeitet, aber leider auch weiterhin die bearbeitet die Grün gefärbt sind :-(

Viele Grüße

 

Hi,

ich sehe den angepassten Code nicht - die Anmerkung in meinem letzten Beitrag hast du anscheinend nicht gelesen?!

Entsprechend deinen vorhandenen Daten sind Zeile 2 und Zeile 3 in deiner Auftragsliste zu bearbeiten, da nur diese beiden Nummern in beiden Tabellen vorhanden sind. Lösche einfach mal die Inhalte der Spalte C in deiner Auftragsliste - dann wirst du sehen, dass nur Zeile 3 einen neuen Eintrag erhält, da Zeile 2 die Bedingung Grün erfüllt und somit übersprungen wird.

Übrigens kann man deinen Code wesentlich einfacher ohne das Konstrukt deiner WorksheetFunction.VLookUp schreiben, da es in VBA die Find-Methode gibt, mit der man Zellinhalte suchen und dann die gefundene Zelle als Ausgang für weitere Zellen nehmen kann:

Code:

Sub SVERWEIS_aus_Shoppingcart_aus_EVOFind()
    Debug.Print Now
    Dim i As Long, letzteZeile As Long
    Dim Datenbasis As Worksheet
    Dim Ziel As Worksheet
    Dim Bereich As Range
    Dim rngSuche As Range
    Set Datenbasis = ThisWorkbook.Worksheets("Shoppingcart_aus_EVO")
    Set Ziel = ThisWorkbook.Worksheets("Arbeitsliste")
    letzteZeile = Datenbasis.Range("K" & Rows.Count).End(xlUp).Row
    Set Bereich = Datenbasis.Range("A1:W" & letzteZeile)
    For i = 2 To Ziel.Range("K" & Rows.Count).End(xlUp).Row
        If Ziel.Range("F" & i).DisplayFormat.Interior.Color <> 11854022 Then
            Set rngSuche = Bereich.Columns(1).Find(Ziel.Range("K" & i).Value)
            If Not rngSuche Is Nothing Then
                Ziel.Range("F" & i).Value = rngSuche.Offset(0, 1)
                Ziel.Range("C" & i).Value = rngSuche.Offset(0, 22)
                Ziel.Range("J" & i).Value = rngSuche.Offset(0, 9)
                Ziel.Range("L" & i).Value = rngSuche.Offset(0, 4)
                Ziel.Range("O" & i).Value = rngSuche.Offset(0, 19)
                Ziel.Range("N" & i).Value = rngSuche.Offset(0, 3)
                Ziel.Range("G" & i).Value = "DG"
            End If
        End If
    Next i
    Debug.Print Now
End Sub

Bis später,
Karin

 

Vielen Dank für deine Geduld und das anpassen meines Code nun geht es :-) DANKE :-)