Werte zuordnen in Spalte

[Kuwer]

Hallo,

anscheinend spinnt da das Intersect bei ganzen Spalten. So sollte das keine Rolle mehr spielen:

Sub Makro1()

  Dim i As Long, j As Long

  Dim rngZ As Range

  Dim varQ As Variant

  Dim varZ As Variant

  With Range("B1", Cells(Rows.Count, 2).End(xlUp))

    varQ = .Offset(, 3).Resize(, 2).Value

    ReDim varZ(1 To UBound(varQ), 1 To 2)

    For i = 1 To UBound(varQ)

      If Len(varQ(i, 1)) Then

        j = Application.Match(varQ(i, 1), Columns(2), 0)

        If j Then

          varZ(j, 1) = varQ(i, 1)

          varZ(j, 2) = varQ(i, 2)

        End If

      End If

    Next i

    .Offset(, 3).Resize(UBound(varZ, 1), UBound(varZ, 2)).Value = varZ

    Application.Intersect(Range("A1:F" & UBound(varZ, 1)), .Offset(, 3).EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow).Interior.Color = vbRed

  End With

End Sub

Gruß Uwe

[cysu11]

Hi Uwe,

nun funktioniert es perfekt!!! Vielen vielen Dank dafür!!! :)

Ich habe den Code nun in meiner Produktivtabelle eingefügt, dort gehen aber die Werte erste ab Zeile 6 los, Spalten sind die gleichen!
Dort funktioniert das leider nicht mehr, habe versucht, das anzupassen, aber wie ich schon sagt, ich verstehe leider den Code garnicht! :(

Wie kann ich den Code anpassen, damit es hier auch funktioniert!?

Vielen Dank & sorry für die Umstände, hätte die Beispieldatei gleich so aufbauen sollen, wie sie im Produktiv auch ist, ich dachte ich bekomme die Anpassungen hin! :)

LG
Alexandra

[Kuwer]

Hallo Alexandra,

ungetestet, da am Handy:

Sub Makro1()

  Dim i As Long, j As Long

  Dim rngZ As Range

  Dim varQ As Variant

  Dim varZ As Variant

  With Range("B6", Cells(Rows.Count, 2).End(xlUp))

    varQ = .Offset(, 3).Resize(, 2).Value

    ReDim varZ(1 To UBound(varQ), 1 To 2)

    For i = 1 To UBound(varQ)

      If Len(varQ(i, 1)) Then

        j = Application.Match(varQ(i, 1), Columns(2), 0)

        If j Then

          j = j - 5

          varZ(j, 1) = varQ(i, 1)

          varZ(j, 2) = varQ(i, 2)

        End If

      End If

    Next i

    .Offset(, 3).Resize(UBound(varZ, 1), UBound(varZ, 2)).Value = varZ

    Application.Intersect(Range("A6:F" & UBound(varZ, 1) + 5), .Offset(, 3).EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow).Interior.Color = vbRed

  End With

End Sub

Gruß Uwe

[cysu11]

Hallo Uwe,

es funktioniert! :)

Neues Problem, wenn alle Werte gefunden werden(also keine rote Zeilen :) , dann kommt hier eine Fehlermeldung:

Code:

    Application.Intersect(Range("A6:F" & UBound(varZ, 1) + 5), .Offset(, 3).EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow).Interior.Color = vbRed

Laufzeitfehler 91..
Objektvariable oder With-Blockvariable nicht festgelegt!?

Vielen lieben dank
LG
Alexandra

[Kuwer]

Hallo Alexandra,

fùge darüber folgende Zeile ein:

On Error Resume Next

Gruß Uwe

[cysu11]

Hi Uwe,

perfekt, jetzt funktioniert es perfekt!

Herzlichen Dank für deine wirklich tolle Hilfe!!! :)

LG
Alexandra