Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
708to712
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
708to712
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datumsvergleich

Datumsvergleich
16.12.2005 19:46:12
Peter
Hallo,
ich habe folgendes Problem:
In der Spalte „A“ der „Tabelle1“ stehen Datumswerte.
Ist eine Datumsangabe aus der drüberliegenden Zeile aus Spalte „A“ vom
Vortag, soll diese in die Spalte “A“ der “Tabelle2“ kopiert werden.
Als Ergebnis sollen keine aufeinanderfolgenden Tage in der gleichen Tabelle stehen.
z.B.
Tabelle1 - Tabelle2
12.01.05 - 13.01.05
27.01.05 - 28.01.05
29.01.05 -
02.02.05 -
Ich habe folgenden Lösungsansatz:
Jedoch funktioniert die Sache nicht, wenn als letzter und vorletzter Eintrag
aufeinanderfolgende Tage stehen.

Sub PruefenKopieren()
Dim intCounter As Integer, intLastRow As Integer
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
For intCounter = 2 To intLastRow
If CDbl(Cells(intCounter, 1).Value) = CDbl(Cells(intCounter + 1, 1).Value - 1 And _
CDbl(Cells(intCounter, 1).Value) Mod 2 = 0 Then
'Worksheets("Tabelle2").Cells(intCounter, 2).Value = Cells(intCounter, 1).Value
Cells(intCounter, 2).Value = Cells(intCounter, 1).Value
': Rows(intCounter).Delete
End If
Next intCounter
End Sub

Danke im voraus Peter

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

Betreff
Datum
Anwender
Anzeige
AW: Datumsvergleich
17.12.2005 01:54:19
Josef
Hallo Peter!
Probier's mal so!
Sub CheckDateAndCut()
Dim objWS1 As Worksheet, objWS2 As Worksheet
Dim lngLastRow As Long, lngRow As Long, lngCopyRow As Long

On Error GoTo ErrExit
Application.ScreenUpdating = False

Set objWS1 = Sheets("Tabelle1")
Set objWS2 = Sheets("Tabelle2")

lngLastRow = objWS1.Range("A65536").End(xlUp).Row
lngCopyRow = 2

For lngRow = 2 To lngLastRow - 1
  If objWS1.Cells(lngRow, 1).Value = objWS1.Cells(lngRow + 1, 1).Value - 1 Then
    objWS1.Cells(lngRow + 1, 1).Copy objWS2.Cells(lngCopyRow, 1)
    objWS1.Cells(lngRow + 1, 1).Delete (xlUp)
    lngCopyRow = lngCopyRow + 1
  End If
Next

ErrExit:
Application.ScreenUpdating = True

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Datumsvergleich - Danke Josef
18.12.2005 10:34:31
Peter
Danke für die schnelle Hilfe.
Code funktioniert einwandfrei.
Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige