Per VBA Datum neben Datensatz setzen

[diving_excel]

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ß

[Kuwer]

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

[Werner.M]

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

[diving_excel]

Vielen Dank an euch, hab beides ausprobiert!

Gruß