Clever-Excel-Forum

Hallo!
Mittels eines VBA Codes möchte ich jeder Zeile einen Datumsstempel verpassen, falls in der jeweiligen Zeile in Spalte C irgendetwas steht und gleichzeitig in Spalte A nichts steht.

Code:
Private Sub CommandButton2_Click()

Dim i As Long

For i = 2 To 100

If Worksheets("Tabelle1").Range("C" & i).Value <> "" And Worksheets("Tabelle1").Range("A" & i).Value = "" Then

   Worksheets("Tabelle1").Range("A" & i) = Date

End If

Next i

End Sub

Das funktioniert auch gut, allerdings braucht mein Code relativ lange bis er durch ist. Kann ich ihn irgendwie optimieren? Bzw. kann ich das ganze vielleicht nicht für jede Zeile einzeln überprüfen sondern in einem Rutsch?

Hintergrund ist, dass in Tabelle1 immer wieder mal Daten eingefügt werden und diese mit einem Eingangsstempel versehen werden sollen. Je mehr Zeilen ein Datensatz hat, desto länger braucht mein Code um da ein Datum daneben zu setzen.

Danke und Gruß

Hallo,

Private Sub CommandButton2_Click()

  Dim i As Long

  Dim vBereich As Variant

  vBereich = Worksheets("Tabelle1").Range("A1").CurrentRegion.Value

  For i = 2 To UBound(vBereich)

    If vBereich(i, 1) = "" And vBereich(i, 3) <> "" Then

      vBereich(i, 1) = Date

    End If

  Next i

  Worksheets("Tabelle1").Range("A1").CurrentRegion.Value = vBereich

End Sub

Gruß Uwe

Hallo,

da ich jetzt auch schon was zusammengeklimpert habe jetzt auch noch meine Version mit dem Autofilter (obwohl du schon eine andere Version hast).

Code:
Private Sub CommandButton2_Click()

With Worksheets("Tabelle1")

    .Range("$A$1:$C$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="="

    .Range("$A$1:$C$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=3, Criteria1:="<>"

    With .AutoFilter.Range.Columns("A")

        .Offset(1).Resize(.Rows.Count - 1) = Date

    End With

    If .AutoFilterMode Then .AutoFilterMode = False

End With

End Sub

Gruß Werner

Hallo,

besser den Code hier. Beim ersten fehlte noch eine Fehlerbehandlung, falls der Filter kein Ergebnis liefert.

Code:
Private Sub CommandButton2_Click()

With Worksheets("Tabelle1")

    .Range("$A$1:$C$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="="

    .Range("$A$1:$C$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=3, Criteria1:="<>"

    With .AutoFilter.Range.Columns("A")

        If .SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then

            .Offset(1).Resize(.Rows.Count - 1) = Date

        End If

    End With

    If .AutoFilterMode Then .AutoFilterMode = False

End With

End Sub

Gruß Werner

Vielen Dank an euch, hab beides ausprobiert!

Gruß

diving_excel

Kuwer

Werner.M

diving_excel