Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1256to1260
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Vergleich & Kopie VBA

Vergleich & Kopie VBA
Florian
Hallo liebe Forums Gemeinde,
Ich habe hier im Forum einen Code gefunden der mein Problem teilweise löst,
leider bin ich mit VBA nicht arg bewandert und wollte nun Fragen ob mir jemand Helfen könnte?
www.herber.de/forum/archiv/424to428/t426241.htm
Den Code habe ich soweit ich konnte auf mein Problem angepasst, mein Frage ist bloß wie schaffe ich es aus Tabelle2 Daten die anstatt in A in F5 beginnen zu vergleichen?
Sub Vergleichen_und_Kopieren()
Sheets("Tabelle2").Select
With Worksheets("RM").Columns(2)
For i = 1 To Cells(65536, 1).End(xlUp).Row
Wert = Cells(i, 1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
If C(1, 5) = "" Then Cells(i, 5).Copy Destination:=C(1, 7)
End If
Next i
End With
End Sub
Wäre um jede Hilfe dankbar und hoffe mich verständlich ausgedrückt zu haben :)

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Vergleich & Kopie VBA
16.04.2012 14:20:14
Peter
Hallo Florian,
versuche es so (mit Definition der Variablen)
Sub Vergleichen_und_Kopieren()
Dim rZelle  As Range
Dim lZeile  As Long
Dim vWert   As Variant
Sheets("Tabelle2").Select
With Worksheets("RM").Columns(2)
For lZeile = 5 To .Cells(Rows.Count, 6).End(xlUp).Row
vWert = Cells(lZeile, 1)
Set rZelle = .Find(vWert, LookIn:=xlValues, LookAt:=xlWhole)
If Not rZelle Is Nothing Then
If rZelle(1, 5) = "" Then .Cells(lZeile, 5).Copy Destination:=rZelle(1, 7)
End If
Next lZeile
End With
End Sub

Gruß Peter
AW: Vergleich & Kopie VBA
16.04.2012 14:33:32
Florian
Hallo Peter,
vielen Dank für deine schnelle Antwort. Leider passiert gar nichts :(
Anzeige
AW: Vergleich & Kopie VBA
16.04.2012 14:38:36
Peter
Hallo Florian
ich weiß nicht woher Du das Makro hast, es kann so auch gar nicht funktionieren.
Was willst Du denn wo suchen?
Gruß Peter
AW: Vergleich & Kopie VBA
16.04.2012 15:01:34
Florian
Also ich habe eine Datei mit mehreren Tabellenblättern. Relevant für dieses Problem ist "Tabelle1" und "RM".
In Tabelle1 stehen in F5 bis F... Namen. Jeder Name hat einen Status der in H5 bis H... eindeutig hinterlegt ist.
In RM stehen die gleichen Namen wie in Tabelle1 aber ab B3 bis B... beginnend.
Jetzt sollte das Makro Tabelle1 F5 mit RM B3 vergleichen. Ist der Name derselbe soll der Status von Tabelle1 H5 in RM H3 kopiert werden. Dabei sind die Daten nicht sortiert, er sollte also alles vergleichen und nur solche kopieren, welche den gleichen Namen haben. Kann auch vorkommen das kein Wert im Status vorhanden ist.
Den Code habe ich von hier und auf mich soweit es ging angepasst. Das hat auch geklappt, solange bei Tabelle1 alles bei A angefangen hat :)
Link zum Post
https://www.herber.de/forum/archiv/424to428/t426241.htm
Anzeige
AW: Vergleich & Kopie VBA
16.04.2012 14:47:11
Peter
Hallo Florian,
ohne es getestet zu haben - vielleicht so?
Sub Vergleichen_und_Kopieren()
Dim WkSh    As Worksheet
Dim rZelle  As Range
Dim lZeile  As Long
Dim vWert   As Variant
Set WkSh = ThisWorkbook.Worksheets("RM")
'Sheets("Tabelle2").Select
With WkSh.Range("F5:F" & WkSh.Cells(Rows.Count, 6).End(xlUp).Row)
For lZeile = 1 To WkSh.Cells(Rows.Count, 6).End(xlUp).Row
vWert = .Cells(lZeile, 1)
Set rZelle = .Find(What:=vWert, LookIn:=xlValues, LookAt:=xlWhole)
If Not rZelle Is Nothing Then
If rZelle(1, 5) = "" Then .Cells(lZeile, 5).Copy Destination:=rZelle(1, 7)
End If
Next lZeile
End With
End Sub

Gruß Peter
Anzeige
AW: Vergleich & Kopie VBA
16.04.2012 15:33:38
Florian
Leider genau das gleiche, nichts.
Warum streikt Excel eigentlich wenn ich schreiben würde:
Sheets("Tabelle2").Columns(6).Select?
Was ist da falsch?
AW: Vergleich & Kopie VBA
16.04.2012 17:07:59
Peter
Hallo Florian,
dann nimm dies Makro, es sollte das tun, was Du beschrieben hast:
Sub Vergleichen_und_Kopieren()
Dim WkSh_1  As Worksheet
Dim WkSh_R  As Worksheet
Dim rZelle  As Range
Dim lZeile  As Long
Dim vWert   As Variant
Set WkSh_1 = ThisWorkbook.Worksheets("Tabelle1")
Set WkSh_R = ThisWorkbook.Worksheets("RM")
For lZeile = 3 To WkSh_R.Cells(Rows.Count, 2).End(xlUp).Row ' nimm die Namen aus Tabelle "RM" _
With WkSh_1.Range("F5:F" & WkSh_1.Cells(Rows.Count, 6).End(xlUp).Row) ' suche in Tabelle1  _
Bereich F5-...
Set rZelle = .Find(What:=WkSh_R.Range("B" & lZeile).Value, LookAt:=xlWhole, LookIn:= _
xlValues)
If Not rZelle Is Nothing Then ' der Name wurde gefunden
If WkSh_1.Range("H" & rZelle.Row)  "" Then ' ist der Status NICHT leer?
WkSh_R.Range("H" & lZeile).Value = WkSh_1.Range("H" & rZelle.Row).Value
End If
End If
End With
Next lZeile
End Sub

Gruß Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige