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