Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
396to400
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
396to400
396to400
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datumsvergleich in 2 Tabellen

Datumsvergleich in 2 Tabellen
11.03.2004 16:13:34
Peter
Hallo Forum,
ich vergleiche in 2 Tabellen in Spalte A Datumswerte.
Bei Übereinstimmung erfolgt ein Eintrag.
Soweit funktioniert die Sache.
Kommt das gleiche Datum jedoch mehrmals vor, wird nur das
1. gefundene Datum gekennzeichnet, obwohl jedes Datum das in
beiden Tabellen vorhanden ist gekennzeichnet werden soll.
Wer kann helfen?
Danke Peter

Sub VergleichEintragen()
'mit Datumswerten
Dim rngFind As Range
Dim intRow As Integer
Worksheets("Ziel").Activate
intRow = 2
Do Until IsEmpty(Cells(intRow, 1))
Set rngFind = Worksheets("Quelle").Columns(1). _
Find(DateValue(Cells(intRow, 1)), LookIn:=xlFormulas)
rngFind.Offset(0, 9).Value = "XXX"
intRow = intRow + 1
Loop
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datumsvergleich in 2 Tabellen
11.03.2004 20:10:00
Christoph
Hi Peter,
du musst für jedes gefundene Datum in "Ziel" die Tabelle "Quelle" komplett durchlaufen.
So wie du das geschrieben hast, ist mit dem "Find" der Task abgearbeitet und "intRow" wird um eins hochgesetzt.
Gruß
Christoph
Bsp. mit For-Schleifen
11.03.2004 20:56:42
Christoph
hallo Peter,
hier mal ein Bsp mit For-Schleifen
Gruß
Christoph
(freu mich über Rückmeldung)

Option Explicit

Sub VergleichEintragen()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LRow1 As Long, LRow2 As Long, i As Long, j As Long
Dim Uebergabe As String
Set ws1 = Worksheets("Ziel")
Set ws2 = Worksheets("Quelle")
LRow1 = ws1.Range("A65536").End(xlUp).Row
LRow2 = ws2.Range("A65536").End(xlUp).Row
For i = 1 To LRow1
Uebergabe = ""
If ws1.Cells(i, 1).Value <> "" Then Uebergabe = ws1.Cells(i, 1).Value
If Uebergabe <> "" Then
For j = 1 To LRow2
If ws2.Cells(j, 1) = Uebergabe Then ws2.Cells(j, 10).Value = "XXX"
Next j
End If
Next i
End Sub

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige