Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Vergleich von Zelleninhalt

Betrifft: Vergleich von Zelleninhalt von: Tom
Geschrieben am: 28.07.2014 08:11:45

Guten Morgen zusammen,

ich möchte in der Tabelle im Anhang die Inhalte (Text/Zahl) in der Spalte C die den gleichen Code in der Spalte B haben, prüfen und die Unterschiede farblich markieren lassen.
Dabei sollte überprüft werden ob es sich um einen Entfall oder ein Hinzu handelt (Spalte A Hinzu = Plus/ Entfall = Minus). Der Entfall sollte eine andere Farbe erhalten als der Hinzutext und sich eindeutig hervorheben.

https://www.herber.de/bbs/user/91751.xlsx

Wie lässt sich das Ganze am besten umsetzen?

Die Tabelle wird über ein Makro aus html importiert und soll bei Übertrag die Unterschiede finden und markieren. Die Anzahl der Inhalte kann je Import variieren.

Vielen Dank für die Unterstützung.

Gruß Tom

  

Betrifft: AW: Vergleich von Zelleninhalt von: fcs
Geschrieben am: 28.07.2014 16:31:56

Hallo Tom,

das Ganze wird leider beliebig kompliziert, wenn mehrere Textpassagen in der Beschreibung geändert sind und nicht nur ein einzelnes Zeichen/Wort. Dann muss nämlich irgendwie ein sukzessiver Wortvergleich innerhalb der Texte erfolgen (vergleich der Teil-Texte von Leerzeichen/Punkt zu Leerzeichen/Punkt).

Außerdem kann ich in deinem Beispiel die Farb-Markierung nicht 100% nachvollziehen - Minus wird rot makiert, Plus wird Blau markiert.
Zeile 7: müsste hier nicht die 2 im Datum rot markiert sein?

Zeile 9: müsste hier nicht die 02 im Datum rot markiert werden?

Zeile 10: müsste hier nicht die 10 im Datum blau markiert werden?

Ein Zusatzfrage: Ist die Liste immer so sortiert, dass identische Codes in Spalte B immer unmittelbar untereinander stehen?

Gruß
Franz


  

Betrifft: AW: Vergleich von Zelleninhalt von: Tom
Geschrieben am: 28.07.2014 20:48:38

Hallo Franz,

ja Du hast natürlich recht, in den Zellen 9,10 und 11 fehlt die Markierung. Ich habe nicht alle Unterschiede hervorgehobenen.
Es sollen alle Änderungen sichtbar gemacht werden. Wenn es die Sache vereinfachen würde, dann gerne auch nur die Plus Positionen.

Zu Deiner zweiten Frage: In der Spalte B stehen, die gleichen Codes wenn es Änderungen gibt untereinander. Aber nicht immer sind zwingend zwei gleiche Codes vorhanden! Es kann sein das unter Plus ein Code komplett neu hinzukommt. In dem Fall könnte die Überprüfung alles blau markieren oder auch ignorieren.

Gruß Tom


  

Betrifft: AW: Vergleich von Zelleninhalt von: fcs
Geschrieben am: 29.07.2014 07:39:20

Hallo Tom,

hab bitte noch etwas Geduld. Ich versuch dann mal heute Abend ein Makro zu programmieren.

Gruß
Franz


  

Betrifft: AW: Vergleich von Zelleninhalt von: Tom
Geschrieben am: 29.07.2014 08:49:40

Guten Morgen Franz,

nur keinen Stress...danke schon einmal dafür.

Das ganze soll dann in Deinem Makro https://www.herber.de/bbs/user/90551.xlsm mit eingebaut werden.


Gruß Tom


  

Betrifft: AW: Vergleich von Zelleninhalt von: fcs
Geschrieben am: 29.07.2014 16:11:55

Hallo Tom,

hier mal ein Ansatz.
Probiere mal ein paar Änderungsvarianten aus, ob es ungefähr passt. Weitere Verfeinerungen der Markierungen werden sehr kompliziert in der Programmierung.

Gruß
Franz

Sub Markieren_Aenderungen()
  Dim wksData As Worksheet
  Dim Zeile As Long, Zeile_L
  Dim strText1 As String, strText2 As String
  Dim bolPlus1 As Boolean, bolPlus2 As Boolean
  Dim FarbePlus As Long, FarbeMinus As Long
  Dim Pos11 As Integer, Pos12 As Integer
  Dim Pos21 As Integer, Pos22 As Integer
  Dim Pos13 As Integer, Pos14 As Integer
  Dim Pos23 As Integer, Pos24 As Integer
  Dim varSplit1, varSplit2, strWort As String
  Dim iWort As Integer, intK
  Dim iWort2 As Integer, iWort22 As Integer
  
  FarbePlus = RGB(Red:=0, Green:=0, Blue:=255)
  FarbeMinus = RGB(Red:=255, Green:=0, Blue:=0)
  
  Set wksData = ActiveSheet
  Application.ScreenUpdating = False
  With wksData
    Set wksData = ActiveSheet
    Zeile_L = .Cells(.Rows.Count, 2).End(xlUp).Row
    'Font-Formatierungen zurücksetzen
    With .Range(.Cells(7, 1), .Cells(Zeile_L, 3))
      With .Font
        .ColorIndex = xlColorIndexAutomatic
        .Bold = False
      End With
    End With
    'Zeilen ab zeile 7 abarbeiten
    For Zeile = 7 To Zeile_L
      If .Cells(Zeile, 2).Value = .Cells(Zeile + 1, 2).Value Then
        'Code 2 mal vorhanden
        bolPlus1 = .Cells(Zeile, 1).Value = "+"
        bolPlus2 = .Cells(Zeile + 1, 1).Value = "+"
        strText1 = .Cells(Zeile, 3).Value
        strText2 = .Cells(Zeile + 1, 3).Value
        'Position des 1. abweichenden Zeichens vom Beginn
        For Pos11 = 1 To Len(strText1)
          If Mid(strText1, Pos11, 1) <> Mid(strText2, Pos11, 1) Then
            Exit For
          End If
        Next Pos11
        Pos21 = Pos11
        'Position des letzen abweichenden Zeichens vom Ende
        Pos22 = Len(strText2)
        For Pos12 = Len(strText1) To 1 Step -1
          If Mid(strText1, Pos12, 1) <> Mid(strText2, Pos22, 1) Then
            Exit For
          End If
          Pos22 = Pos22 - 1
        Next Pos12
        'Text 1 markieren von 1. bis letzter Änderung
        Call prcMarkierenText(Zelle:=.Cells(Zeile, 3), Pos1:=Pos11, Pos2:=Pos12, _
            Farbe:=IIf(bolPlus1, FarbePlus, FarbeMinus))
        'Text 2 markieren von 1. bis letzter Änderung
        Call prcMarkierenText(Zelle:=.Cells(Zeile + 1, 3), Pos1:=Pos21, Pos2:=Pos22, _
            Farbe:=IIf(bolPlus2, FarbePlus, FarbeMinus))
    
    'prüfen ob im markierten Bereich Leerzeichen enthalten sind --> mehrere Wörter.
        'Markierten Text herausschneiden
        strText1 = Mid(strText1, Pos11, Pos12 - Pos11 + 1)
        strText2 = Mid(strText2, Pos21, Pos22 - Pos21 + 1)
    'prüfen ob im markierten Bereich Leerzeichen enthalten sind --> mehrere Wörter.
        If InStr(1, strText1, " ") > 0 And InStr(1, strText2, " ") > 0 Then
          'Punkte in den markierten Texten durch Leerzeichen ersetzen
          strText1 = VBA.Replace(strText1, ".", " ")
          strText2 = VBA.Replace(strText2, ".", " ")
          'Texte am Leerzeichen splitten für Wortvergleich
          varSplit1 = Split(strText1, " ")
          varSplit2 = Split(strText2, " ")
          
          If UBound(varSplit1) > 1 And UBound(varSplit2) > 1 Then
            'wortweiser Vergleich nach 1. geänderten Zeichen
            iWort2 = 1
            For iWort = 1 To UBound(varSplit1) - 1
              strWort = varSplit1(iWort)
              
              'Wort im 2. Text suchen
              For iWort22 = iWort2 To UBound(varSplit2)
                If varSplit2(iWort22) = strWort Then
                  iWort2 = iWort22
                  
                  Pos23 = Pos21
                  For intK = 0 To iWort2 - 1
                    Pos23 = Pos23 + Len(varSplit2(intK)) + 1
                  Next
                  Pos24 = Pos23 + Len(varSplit2(iWort2))
                  
                  Pos13 = Pos11
                  For intK = 0 To iWort - 1
                    Pos13 = Pos13 + Len(varSplit1(intK)) + 1
                  Next
                  Pos14 = Pos13 + Len(varSplit1(iWort))
                  
                'Text 1 Markierung entfernen
                  Call prcMarkierenTextNo(Zelle:=.Cells(Zeile, 3), Pos1:=Pos13, Pos2:=Pos14)
                'Text 2 Markierung entfernen
                  Call prcMarkierenTextNo(Zelle:=.Cells(Zeile + 1, 3), Pos1:=Pos23, Pos2:=Pos24) _

                  Exit For
                End If
              Next iWort22
            Next iWort
          End If
        End If
        Zeile = Zeile + 1
      Else
        'Code nur 1 mal vorhanden - Code wird farblich hervorgehoben
        With .Cells(Zeile, 2)
          If .Offset(0, -1).Value = "+" Then
            With .Font
              .Bold = True
              .Color = FarbePlus
            End With
          Else
            With .Font
              .Bold = True
              .Color = FarbeMinus
            End With
          End If
        End With
      End If
    Next
  End With 'wksData
  Application.ScreenUpdating = True
End Sub



  

Betrifft: AW: Vergleich von Zelleninhalt von: Tom
Geschrieben am: 29.07.2014 20:59:33

Hallo Franz,

in der Zeile kommt der Fehler Sub oder Function nicht definiert!

Call prcMarkierenText(Zelle:=.Cells(Zeile, 3), Pos1:=Pos11, Pos2:=Pos12, _
Farbe:=IIf(bolPlus1, FarbePlus, FarbeMinus))

Wo fehlt etwas?

Gruss Tom


  

Betrifft: AW: Vergleich von Zelleninhalt von: fcs
Geschrieben am: 30.07.2014 01:53:52

Hallo Tom,

da hatte ich versehentlich die beiden folgenden Makros nicht mit kopiert.

Gruß
Franz

Sub prcMarkierenText(Zelle As Range, Pos1 As Integer, Pos2 As Integer, Farbe As Long)
    With Zelle.Characters(Start:=Pos1, Length:=Pos2 - Pos1 + 1).Font
        .Color = Farbe
        .Bold = True
    End With
End Sub

Sub prcMarkierenTextNo(Zelle As Range, Pos1 As Integer, Pos2 As Integer)
    With Zelle.Characters(Start:=Pos1, Length:=Pos2 - Pos1 + 1).Font
        .ColorIndex = xlColorIndexAutomatic
        .Bold = False
    End With
End Sub



  

Betrifft: AW: Vergleich von Zelleninhalt von: Tom
Geschrieben am: 31.07.2014 15:44:23

Hallo Franz,

gut jetzt funktionierts!!!


Vielen Dank

Viele Grüße
Tom


 

Beiträge aus den Excel-Beispielen zum Thema "Vergleich von Zelleninhalt"

Zellen vergleichen und markieren
Tabellen vergleichen
Tabellenvergleich und Übernahme der Doppel
Spalten A und B vergleichen und Doppel in C listen
Werte vergleichen
Bereiche auf Übereinstimmung vergleichen
Daten in jeweils einer Spalte zweier Tabellen vergleichen
SVERWEIS, WVERWEIS, INDEX, VERGLEICH und Zielwertsuche
Werte vergleichen und Ergebnis in Tabelle eintragen
Preisvergleiche
Tabellen vergleichen und Zeilen ersetzen
Tabellen vergleichen und bei Nichtübereinstimmung markieren
Textdateien vergleichen und Unterschiede dokumentieren
Setzen der Hintergrundfarbe nach Wertevergleich
Spalte A mit B vergleichen und Doppel in C eintragen
Tabellenvergleich über die bedingte Formatierung
Telefonnumern mit Liste vergleichen und durch Namen ersetzen
Vergleich von zwei Listen und Ausgabe eines Wahrheitswertes
Nach Vergleich Kommentar einfügen
Vergleich von Zellwerten mit unterschiedlichen Methoden
Werte vergleichen und übertragen
Teilstrings vergleichen und markieren
Bei TextBox-Eingaben Mustervergleich und Formatierung
Textmuster vergleichen
Unterschiedliche Smilies bei Zellvergleich