Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1524to1528
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
Inhaltsverzeichnis

Macro bei bestimmtem Zellwert ausführen

Macro bei bestimmtem Zellwert ausführen
23.11.2016 12:02:09
Dirk
Hallo, ich lese und doktere und doktere und lese. Aber ich kriege es nicht gebacken.
Ich habe ein Tabellenblatt und möchte sobald im Bereich der row7 (AA7:BB7) eine "1" eingegeben wird, ein Macro gestartet wird, das mir in der Zeile 7 Werte in bestimme Zellen schreibt.
Das selbe Macro soll gestartet werden wenn ich in die übernächste nächste Zeile AA9:BB9
eine "1" eingebe usw.
Bei AA205:BB205 wäre Schluss. (Immer ungrade Zahlen weil zwei Zeilen gemergt sind)
Ich habe es schon mal für eine Zeile hingekriegt, aber das auszuführende macro stoppt bei dem Befehl:
.Cells(lngThisRow, .Range("Comments").Column).MergeArea.Activate
und Excel schmiert komplett ab.
Vermutlich weil das mit dem "Target as Range" im Befehl nicht kompatibel ist) "Private Sub Worksheet_Change(ByVal Target As Range)
Den aber brauche ich für die korrekte Ausführung des Macros.
Hört sich komplex an, ist es für mich auch :-(
Evtl. kann mir einer helfen?
Verzweifelte Grüße,
Dirk

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
bissken dürftig,
23.11.2016 12:18:20
Rudi
Hallo,
mehr Code oder besser die Mappe wäre hilfreich.
Gruß
Rudi
AW: ein Ansatz
23.11.2016 13:02:34
Fennek
Hallo,
versuche diesen Code zum Starten des Makros:

Private Sub Worksheet_Change(ByVal Target As Range)
if target.row  205 then exit sub
if Target.row mod 2 = 0 then exit sub
'Hier die "Nutzlast"
end sub
"MergeCell" ist oft problematisch, es wäre besser einen anderen Weg zu wählen.
mfg
AW: ein Ansatz
23.11.2016 13:22:37
Dirk
Danke für den Start Code. Das hilft schon mal weiter!
Mit Worksheet_Change(ByVal Target As Range)
hatte ich ja das Problem das bei
Dim lngThisRow As Long
lngThisRow = ActiveCell.Row
With activesheet
'Set active cell now in case the overwrite question
'is asked, so the user will see the current values.
.Cells(lngThisRow, .Range("Comments").Column).MergeArea.Activate
der Code gehangen hat. Was bei manuellem Ausführen nicht der Fall ist.
Mal schauen ob ich was anderes finde?
Gruß,
Dirk
Anzeige
AW: ein Ansatz
23.11.2016 14:01:52
Dirk
Du hast Recht, es scheint am Merge zu liegen. Keine Ahnung wie ich ds lösen soll, der Code läuft in der Form schon ewig problemlos, und ICH kriege den nicht umgeschrieben.
OK....
Danke trotzdem!
Ciao,
Dirk
vielleicht...
23.11.2016 17:51:22
Michael
Hi,
schau mal das:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tr As Long, Cc As Long
If Target.Count  1 Or Target.Value  1 Then Exit Sub
tr = Target.Row
If tr  205 Then Exit Sub
If tr Mod 2 = 0 Then Exit Sub
'Hier die "Nutzlast"
MsgBox "Das ist Nr. der Zeile: " & tr
' wozu das .cells...activate?
Cc = Range("Comments").Column
' in extra Variable, falls öfter benötigt
Cells(tr, Cc) = "1 in " & Target.Address(0, 0)
End Sub

Alles weitere nur mit komplettem Code - den hatte Rudi sich ja schon gewünscht...
Das ganze "activesheet" ist für die Katz, da das Makro ja sowieso nur im "aktiven" Blatt anspringt.
Gruß,
Michael
Anzeige
AW: dann so: Datei anbei
24.11.2016 08:42:35
Dirk
Hallo Michael,
tausend Dank! Genauso sollte das aussehen! Jetzt muss ich nur noch genau verstehen und einbauen.
Also nochmals Danke!!! und schonmal vorab ein schönes Wochenende.
Gruß,
Dirk
AW: dann so: Datei anbei
24.11.2016 10:27:19
Dirk
Hallo Michael,
ich habe den Code mal in meinem Tabellenblatt eingebaut. Keine Fehlermeldung mehr, aber auch sonst passiert nichts. In deiner Beispieltabelle funzt das wie gewünscht. Mir fehlen wohl einfach die Grundlagen ob die Ursache zu finden. Frage mich ob ich nicht erstmal "Call CopyGPSInfo()" ausführen muss um die Werte zu kriegen? Mit "GetGPSLogLastLine" passiert jedenfall nichts.
Vba ist immer wieder frustierend für mich weil ich nicht wirklich genau weiß wann was passiert.
Gruß,
Dirk
Anzeige
AW: dann so: Datei anbei
24.11.2016 14:12:02
Michael
Hi Dirk,
ohne Beispieldatei ist das halt immer so eine Sache: wenn wir nicht *exakt* wissen, wie die aufgebaut ist, kann es zu genau solchen Komplikationen kommen.
Also nochmal von vorne.
1. Richtiges Modul?
Der Code in meiner Datei
Option Explicit
' nur zur Simulation der Function *************************
Dim xx#, yy#, dd&
Function GetGPSLogLastLine(ByRef x#, ByRef y#, ByRef d As Date) As Boolean
' nur zur Simulation des Originals
xx = xx + 1: x = xx
yy = yy + 1: y = yy
If dd = 0 Then dd = Date Else dd = dd + 1
d = dd
GetGPSLogLastLine = True
End Function
' nur zur Simulation der Function *************************
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tr As Long, Cc&, Kc&(1 To 3), i& ' & = as long, comment,andere Spalten
Dim pW(1 To 3)                   ' die Werte
Dim keineFrage As Boolean
Dim dblLon As Double, dblLat As Double
Dim pGPSTime As Date
If Target.Count  1 Or Target(1).Text  "1" Then Exit Sub
tr = Target.Row
If tr  205 Then Exit Sub
If tr Mod 2 = 0 Then Exit Sub
If Not GetGPSLogLastLine(dblLon, dblLat, pGPSTime) Then Exit Sub
Cc = Range("Comments").Column
Kc(1) = Range("X_Coord").Column
Kc(2) = Range("Y_Coord").Column
Kc(3) = Range("GPS_Time").Column
pW(1) = dblLon: pW(2) = dblLat: pW(3) = pGPSTime
' um die GetGPS-Function nicht ändern zu müssen
Cells(tr, Cc).Activate ' wozu?
keineFrage = True
For i = 1 To 3: keineFrage = keineFrage And Cells(tr, Kc(i)) = Empty: Next
If Not keineFrage Then
If Not MsgBox("Overwrite existing coordinates?" & vbCrLf & _
"(You typed '1')", vbYesNo + vbDefaultButton2 + _
vbMsgBoxSetForeground, ActiveWorkbook.Name) = vbYes Then Exit Sub
End If
'  .Unprotect ? falls protect-ed, kann keine 1 eingegeben werden.
'  evtl. eingangs noch eine Abfrage auf target.column?!
Application.EnableEvents = False
For i = 1 To 3: Cells(tr, Kc(i)) = pW(i): Next
Application.EnableEvents = True
'  .Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End Sub

befindet sich zunächst im Modul des Tabellenblatts "Tabelle1":
Userbild
In Deinem Originalcode war die Zeile
ActiveSheet.Name  "Back_Sheet(s)"

die darauf hindeutet, daß der Code in das Modul vom Blatt "Back_Sheet(s)" reinmuß.
Ereignismakros funktionieren NUR in dem Blatt, in dessen Modul sie stehen!
(Deshalb ist auch das ganze "activesheet"... überflüssig, weil nur diese eine Blatt sowieso aktiv ist, wenn das Makro überhaupt auf ein Ereignis "anspringt")
2. Überflüssiges gelöscht?
Die Zeilen zwischen den Kommentaren mit den vielen *** müssen bei Dir raus - ich habe nur die (mir unbekannte) Funktion nachgebildet, damit Du es eben ohne Änderungen verwenden kannst (oder können solltest).
3. Allgemeines Vorgehen
Um zu sehen, ob das Ereignis überhaupt anspringt, setzt Du am besten mal ein "stop" ganz an den Anfang, also so:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tr As Long, Cc&, Kc&(1 To 3), i& ' & = as long, comment,andere Spalten
Dim pW(1 To 3)                   ' die Werte
Dim keineFrage As Boolean
Dim dblLon As Double, dblLat As Double
Dim pGPSTime As Date
stop '  1 Or Target(1).Text  "1" Then Exit Sub
' usw.

Das "stop" sorgt dafür, daß das Makro an dieser Stelle stehenbleibt (ginge auch mit dem Setzen eines Haltepunktes mit F9); dann kannst Du es weiter zeilenweise mit F8 laufen lassen. Währenddessen siehst Du, wenn Du die Maus über eine Variable ziehst (ohne zu klicken), was die für einen Wert während der Laufzeit hat.
Auf die Art siehst Du
a) ob das Makro überhaupt anspringt (wenn es beim Stop nicht stehenbleibt, wurde es nicht aufgerufen)
b) an welcher Stelle das Makro vorzeitig endet und im besten Fall warum.
Spiel mal damit herum. Falls das alles nicht hilft, müßten wir die Originaldatei sehen - schlimmstenfalls dann halt per mail.
Schöne Grüße,
Michael
Anzeige
AW: dann so: Datei anbei
24.11.2016 17:03:28
Dirk
Hallo Michael,
habe den halben Tag rumgefummelt (Versuch und Irrtum) und jetzt läuft es, nachsem ich ein paar Sachen z.b. die Frage nach dem Überschreiben weggelassen habe.
habe noch eine kleine Frage wie ich Exit Sub wenn die Summe in zwei bestimmten Ranges bestimmte Bedingungen erfüllt sind. Einmal wenn "SpeedLimit_Delta" größer 1 ist ODER wenn in der Range Current_ETA ungleich nichts ist.
Morgen mehr dazu
Gruß,
Dirk
AW: dann so: Datei anbei
24.11.2016 18:18:44
Michael
Hi,
es ist halt relativ umständlich, die Spalten-Nummern zu den einzelnen Überschriften bzw. mit Namen versehenen Bereichen zu ermitteln (z.B. Kc(1) = Range("X_Coord").Column)
Wenn sich Deine Tabellenstruktur nicht laufend ändert, ist die Abfrage simpel, etwa hier anzubringen:
If tr Mod 2 = 0 Then Exit Sub      ' nach dieser Zeile dann:
If cells(tr,3) >1 Then Exit Sub    ' halt mit fixen Spaltennummern
'usw.
Gruß,
Michael
Anzeige
AW: bissken dürftig,
23.11.2016 13:03:03
Dirk
OK, hier ist der Code der stoppt und bei dem sich Excel aufhängt. Diesen Code starte ich normalerweise mit einem Hotkey, was auch einwandfrei funzt.
Nur mit dem starten aus einer Funktion hakt es...
Public Sub CopyGPSInfo()
'Attribute CopyGPSInfo.VB_ProcData.VB_Invoke_Func = "a\n14"
'Link this Sub to keyboard shortcut: Ctrl+a
'Must be in a worksheet. ActiveSheet returns Nothing if no sheet is active.
If activesheet Is Nothing Then Exit Sub
'ActiveSheet must be "Back_Sheet(s)".
If activesheet.Name  "Back_Sheet(s)" Then Exit Sub
Dim dblLon As Double, dblLat As Double
Dim pGPSTime As Date
If Not GetGPSLogLastLine(dblLon, dblLat, pGPSTime) Then Exit Sub
Dim lngThisRow As Long
lngThisRow = ActiveCell.Row
With activesheet
'Set active cell now in case the overwrite question
'is asked, so the user will see the current values.
.Cells(lngThisRow, .Range("Comments").Column).MergeArea.Activate
Dim pLonRange As Range, pLatRange As Range, pTimeRange As Range
Set pLonRange = .Cells(lngThisRow, .Range("X_Coord").Column).MergeArea.Cells(1, 1)
Set pLatRange = .Cells(lngThisRow, .Range("Y_Coord").Column).MergeArea.Cells(1, 1)
Set pTimeRange = .Cells(lngThisRow, .Range("GPS_Time").Column).MergeArea.Cells(1, 1)
If LenB(pLonRange.Text)  0 And LenB(pLatRange.Text)  0 And LenB(pTimeRange.Text)  0  _
Then
If Not MsgBox("Overwrite existing coordinates?" & vbCrLf & _
"(You typed Ctrl+a)", vbYesNo + vbDefaultButton2 + vbMsgBoxSetForeground, _
ActiveWorkbook.Name) = vbYes Then Exit Sub
End If
'Write values.
.Unprotect
pLonRange.Value = dblLon
pLatRange.Value = dblLat
pTimeRange.Value = pGPSTime
.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End With 'activesheet
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige