Thema: Datensatz alle 10 Sekunden gruppenweise eintragen.

ClassModule: DieseArbeitsmappe

Private Sub Workbook_Open()
   Call StopEintragen
End Sub

StandardModule: basMain

Public Const giIntervall As Integer = 10
Public Const gsMacro As String = "WerteEintragen"
Public gdNextTime As Double

Sub StartEintragen()
   gdNextTime = Now + TimeSerial(0, 0, giIntervall)
   Application.OnTime earliesttime:=gdNextTime, _
      procedure:=gsMacro, schedule:=True
End Sub

Private Sub WerteEintragen()
   Dim iRow As Integer, intCol As Integer
   iRow = RealLastCell(ActiveSheet).Row
   If WorksheetFunction.CountA( _
      Range(Cells(iRow, 2), Cells(iRow, 13))) = 12 Then
      iRow = iRow + 1
      intCol = 2
   Else
      intCol = WorksheetFunction.CountA( _
         Range(Cells(iRow, 2), Cells(iRow, 13))) + 2
   End If
   Cells(iRow, intCol) = Now
   Cells(iRow, intCol + 1) = Range("A1").Value
   Call StartEintragen
End Sub

Sub StopEintragen()
   On Error Resume Next
   Application.OnTime earliesttime:=gdNextTime, _
      procedure:=gsMacro, schedule:=False
End Sub

Private Function RealLastCell(TheSheet As Worksheet) As Range
   Dim ExcelLastCell As Range
   Dim Row%, Col%, LastRowWithData%, LastColWithData%
   Set ExcelLastCell = TheSheet.Cells.SpecialCells(xlLastCell)
   LastRowWithData = ExcelLastCell.Row
   Row = ExcelLastCell.Row
   Do While Application.CountA(TheSheet.Rows(Row)) = 0 And Row <> 1
      Row = Row - 1
   Loop
   LastRowWithData = Row
   LastColWithData = ExcelLastCell.Column
   Col = ExcelLastCell.Column
   Do While Application.CountA( _
         TheSheet.Columns(Col)) = 0 And Col <> 1
      Col = Col - 1
   Loop
   LastColWithData = Col
   Set RealLastCell = TheSheet.Cells(Row, Col)
End Function

Beiträge aus dem Excel-Forum zu den Themen Ereignis und OnTime