Werte zuordnen in Spalte

[cysu11]

Hallo zusammen,

ich benötige wieder mal Hilfe in Sachen VBA :)

In der angehängten Datei sind in den Spalten A und B Daten. In spalten E und F ebenfalls. Nun möchte ich per Knopfdruck, dass die Werte in Spalte E sortiert werden, so dass die Werte aus Spalte B mit denen aus Spalte E in der gleichen Zeile stehen, natürlich sollen die Werte in F mitsortiert werden. Am Ende wird in mein Beispiel ein Werte in Spalte B ohne dazugehörigen Wert in Spalte E bleiben, die Zeile soll dann rot markiert werden! Natürlich wenn es mehrere Werte gibt in B die nicht in E gefunden werden, sollen diese zeile auch rot markiert werden!

Ich hoffe ich habe mich einigermassen verständlich ausgedrückt! :)

Vielen lieben Dank im Voraus
LG
Alexandra

[Kuwer]

Hallo Alexandra,

Sub Makro2()

  Dim rngZ As Range

  

  With Range("E1:F21")

    .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo

    For Each rngZ In .Columns(1).Cells

      If rngZ.Value <> rngZ.Offset(, -3).Value Then

        rngZ.Resize(1, 2).Insert xlDown

        rngZ.Offset(-1, -4).Resize(1, 6).Interior.Color = vbRed 'RGB(255, 0, 0)

      End If

    Next rngZ

  End With

End Sub

Gruß Uwe

[cysu11]

Hallo Uwe,

vielen Dank für deine Antwort, das funktioniert in meine Beispieldatei super! Das Problem ist, wenn die Werte in Spalte B nicht nummerisch sortiert sind, was ja vorkommt und darf auch nicht verändert werden, dann funktioniert das Ganze nicht! :(
Wie kann ich den Code änder, damit das auch berücksichtigt wird?

Vielen lieben Dank nochmals
LG
Alexandra

[Kuwer]

Hallo Alexandra,

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

    .Offset(, 3).EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow.Interior.Color = vbRed

  End With

End Sub

Gruß Uwe

[cysu11]

Hallo Uwe,

ich muss gestehen, ich verstehe den Code gar nicht! :(

Aber, er tut was er soll! :)
und dafür ein großes Dankeschön!!!

Nur noch zwei Fragen, ich möchte doch nicht daß die ganze Zeile gefärbt wird sonder nur von A bis F?

Nachdem nur Bahnhof verstehe:

.Offset(, 3).EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow.Interior.Color = vbRed
 
wie muss ich das ändern!?

und zweite Frage. es werden je nachdem wie viele rot markiert werden auch entsprechend viele Zeilen unter der Tabelle rot markiert, das sollte nicht sein!?

Vielen lieben Dank
LG
Alexandra

[Kuwer]

Hallo Alexandra,

zu Frage 1:

    Application.Intersect(Range("A:F"), .Offset(, 3).EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow).Interior.Color = vbRed

Frage 2 kann ich nicht nachvollziehen.

Gruß Uwe

[cysu11]

Hi Uwe,

ich habe nochmals die Beispieldatei hochgeladen mit dem Code, damit Du das nachvollziehen kannst! :)

Ich meine die 3 roten Zeilen unter der Tabelle!?

Lieben Dank nochmals 
LG
Alexandra

[Kuwer]

Hallo Alexandra,

Ich meine die 3 roten Zeilen unter der Tabelle!?

das sagt mir trotzdem nichts. Wenn ich die Formatierung entferne und dann das Makro starte, sind diese 3 Zeilen nicht (mehr) rot.

Gruß Uwe

[cysu11]

Hallo Uwe,

also ich kann mir das nicht erklären, aber wenn ich z.B. in A23 bis A30 irgendwas eintrage und dann wieder rauslösche und dann den Code starte dann werden diese Zeilen mit rot gefärbt!? Auch wenn ich z.B. diese Zellen nur farblich markiere und dann die Farbe wieder entferne dann das Selbe!?

Kannst du das auch mal testen ob es bei Dir dann auch so ist?

Lieben Dank
LG
Alexandra

[schauan]

Hallöchen,

bei mir werden die auch wieder rot.

In der Überwachung hab ich
"$A$8:$F$8,$A$13:$F$13,$A$18:$F$18,$A$23:$F$25"

Andererseits, wenn ich zuerst alles von Zeile 23 bis ganz unten markiere und die Zeilen lösche, funktioniert es.