vergleich von Zellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Raphael,
damit das kopieren einfacher geht, nimm das Makro aus diesem Beitrag:

Option Explicit
Public Sub Zusammenfuehren()
Dim WkSh_Q    As Worksheet
Dim WkSh_Z    As Worksheet
Dim lLetzte   As Long
Dim lZeile_Q  As Long
Dim lZeile_Z  As Long
   Application.ScreenUpdating = False
   Set WkSh_Q = Worksheets("Tabelle2")
   Set WkSh_Z = Worksheets("Tabelle3")
'
'   erstmal werden die Spalten A bis F in ein neues Tabellenblatt übertragen
'
   lLetzte = IIf(WkSh_Q.Range("A65536") <> "", 65536, _
      WkSh_Q.Range("A65536").End(xlUp).Row)
   WkSh_Q.Range("A1:F" & lLetzte).Copy Destination:=WkSh_Z.Range("A1:F" & lLetzte)
'
'   dann werden die Spalte B gegen die Spalte G verglichen
'   bei Gleichheit wird die Zelle der Spalte G übernommen
'
   For lZeile_Z = 1 To WkSh_Z.Range("A65536").End(xlUp).Row
      For lZeile_Q = 1 To WkSh_Z.Range("A65536").End(xlUp).Row
         If UCase(WkSh_Z.Range("B" & lZeile_Z).Value) = _
            UCase(WkSh_Q.Range("G" & lZeile_Q).Value) Then
            WkSh_Z.Range("G" & lZeile_Z).Value = _
            WkSh_Q.Range("G" & lZeile_Q).Value
            Exit For
         End If
      Next lZeile_Q
   Next lZeile_Z
   Application.ScreenUpdating = True
End Sub

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.

Hallo Raphael,
eine zweite Variante, in der die Daten aus Spalte G in die Spalte H aber in die richtige Zeile zugeordnet werden. Anschließend kannst du die Spalte G löschen.
Hier wird kein neues Tabellenblatt benötigt, es geht alles im gleichen Blatt.

Public Sub Zuordnen()
Dim WkSh      As Worksheet  ' das zu bearbeitende Tabellenblatt
Dim lLetzte   As Long       ' die letzte belegte Zeile in Spalte A
Dim lZeile_B  As Long       ' For/Next Zeilenindex Spalte B
Dim lZeile_G  As Long       ' For/Next Zeilenindex Spalte G
   Application.ScreenUpdating = False ' Bildschirm Update unterdrücken
   Set WkSh = Worksheets("Tabelle2") ' hier ggf. den Tabellenblatt-Namen anpassen
'
'   die letzte belegte Zeile in der Spalte A feststellen
'
   lLetzte = IIf(WkSh.Range("A65536") <> "", 65536, _
      WkSh.Range("A65536").End(xlUp).Row)
'
'   die Spalte B mit der Spalte G vergleichen und bei Gleichheit den Inhalt
'   der Spalte G in die Zeile der Spalte B in Spalte H übertragen
'
   For lZeile_B = 1 To lLetzte    ' Spalte B von 1 bis zur letzten belegten Zeile
      For lZeile_G = 1 To lLetzte ' Spalte G von 1 bis zur letzten belegten Zeile
         If UCase(WkSh.Range("B" & lZeile_B).Value) = _
            UCase(WkSh.Range("G" & lZeile_G).Value) Then ' Zelle in B = Zelle in G ?
            WkSh.Range("H" & lZeile_B).Value = _
            WkSh.Range("G" & lZeile_G).Value       ' Wert aus G nach H übertragen
            Exit For                               ' For/Next verlassen
         End If
      Next lZeile_G        ' nächste Zeile in Spalte G
   Next lZeile_B           ' nächste Zeile in Spalte B
   Application.ScreenUpdating = True  ' Bildschirm Update freigeben
End Sub

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread