Programmierung Makro ständige Prüfung auf Änderung

Guten Tag,
ich sende diese Beitrag noch einmal, da ich noch keine Lösung habe.
ich habe mit Excel und VBA kaum Erfahrung.
Ich habe eine Exceldatei mit 2 Arbeitsblättern.
Ich benötige ein Makro, welches manuell gestartet wird und folgendes macht:
Prüfe jede Minute:
gehe in Arbeitsblatt 1
gehe in Zeile 3, nimm den Wert aus Spalte E und aus Spalte B
gehe dann in Arbeitsblatt 2
Suche in Spalte A den Wert aus E, gehe in Zeile 3 und suche mit Wert aus B die entsprechende Spalte ergibt
wenn die Zelle leer ist, dann nimm aus Arbeitsblatt 1 aus Zeile 3 den Wert von Spalte G, ansonsten mache nichts, gehe dann im Arbeitsblatt in die nächste Zeile bis zum ende, also bis Spalte A leer ist.
Falls das nicht in Rahmen eines Forumbeitrages gelöst werden kann, bin ich offen für Angebote für eine Auftragsprogrammierung.
Vielen Dank!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stefan,
nachfolgend entsprechende Makros, die die OnTime-Methode nutzen, um in regelmäßigen Abständne das Prüfmakro zu starten.
Gruß
Franz

Option Explicit
'Makros in einem allgemeinen Modul der Datei
Public datNextStart As Date
Sub prcOnTimeStart()
Call prcOnTimeMakro
End Sub
Sub prcOnTimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=datNextStart, Procedure:="prcOnTimeMakro", schedule:=False
End Sub
Sub prcOnTimeMakro()
Dim Wert_E3, Wert_B3, Wert_G3
Dim Zeile As Long, Spalte As Long
Dim rngSuchen As Range
With ThisWorkbook.Worksheets("Tabelle1") 'Name ggf. anpassen
Wert_E3 = .Range("E3")
Wert_B3 = .Range("B3")
Wert_G3 = .Range("G3")
End With
With ThisWorkbook.Worksheets("Tabelle2") 'Name ggf. anpassen
'Spalte mit Wert aus B3 in Zeile 3 suchen
Set rngSuchen = .Rows(3).Find(what:=Wert_B3, LookIn:=xlValues, lookat:=xlWhole)
If Not rngSuchen Is Nothing Then
Spalte = rngSuchen.Column
'Zeile mit Wert aus E3 in Spalte A suchen
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rngSuchen = .Columns(1).Find(what:=Wert_E3, after:=.Cells(Zeile + 1, 1), _
LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
If Not rngSuchen Is Nothing Then
For Zeile = rngSuchen.Row To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Zeile, 1) = Wert_E3 And IsEmpty(.Cells(Zeile, Spalte)) Then
.Cells(Zeile, Spalte) = Wert_G3
End If
Next
End If
End If
End With
datNextStart = Now + TimeSerial(Hour:=0, Minute:=1, Second:=0) 'minwert = 1 Sekunde
Application.OnTime EarliestTime:=datNextStart, Procedure:="prcOnTimeMakro"
End Sub
'Das folgende Makro einfügen unter "DieseArbeitsmappe"
'Beendet vor dem Schließen der Datei ggf. die Ausführung des OnTime-Makros
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call prcOnTimeStop
End Sub

Beliebteste Forumthreads (12 Monate)

Programmierung Makro ständige Prüfung auf Änderung

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread