Nachfrage wg. VBA(Speziell Stefan Br. gerichtet)

Natürlich auch an andere, wenn jemand außer Stefan noch durchblickt.
Hallo,
die u.g. Formel gefällt mir so gut, daß ich sie erweitern möchte(und vergeblich versucht habe bereits).
Möchte zusätzlich zu dem Kopiervorgang in die 2. Zeile , geknüpft an eine Änderung in "D", ein weiteres Macro hinzufügen, diemal Änderungen in Spalte "E", gesamte betroffene Zeile in die 3. Zeile kopiert.
Einfaches hinzukopieren und ersetzen von D und 2 durch E und 3 war nicht sehr erfolgreich. Blickt hier jemand durch(natürlich auch durch meine Formulierung des Problemes..)
Dies steht unter "Tabelle2(Code)
Weiter unten Macro1
Dim myArray(540)
Dim bolTimer As Boolean
Sub Show_change()
For i = 7 To 540
If Range("D" & i).Value myArray(i - 7) Then
If Not (Range("D" & i).Value = 0) And Not (Range("D" & i).Value = Chr(133)) Then
Application.ScreenUpdating = False
Rows(i).Copy
Rows(2).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("D" & i).Select
Call sndPlaySound32("c:\signal", 1)
Application.ScreenUpdating = True
End If
myArray(i - 7) = Range("D" & i)
End If
Next i
Call Timer
End Sub
Sub Timer()
Dim NextTime As Date
If Not bolTimer Then Exit Sub
NextTime = Now + TimeValue("00:00:05")
Application.OnTime NextTime, "Tabelle2.Show_Change"
End Sub
Sub initialize_array()
For i = 7 To 540
myArray(i - 7) = Range("D" & i)
Next i
End Sub
Sub Start_Ueberwachung()
initialize_array
bolTimer = True
Timer
End Sub
Sub Stopp_Ueberwachung()
bolTimer = False
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub

Hier Macro1
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/31/2006 by Stefan Brandstetter
'
'
Rows("12:12").Select
Selection.Copy
Rows("2:2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D12").Select
Application.CutCopyMode = False
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim myArray(540) Dim myArray2(540) Dim bolTimer As Boolean Sub Show_change() For i = 7 To 540 If Range("D" & i).Value <> myArray(i - 7) Then If Not (Range("D" & i).Value = 0) And Not (Range("D" & i).Value = Chr(133)) Then Application.ScreenUpdating = False Rows(i).Copy Rows(2).PasteSpecial xlPasteValues Application.CutCopyMode = False Range("D" & i).Select Call sndPlaySound32("c:\signal", 1) Application.ScreenUpdating = True End If myArray(i - 7) = Range("D" & i) End If Next i Call Show_change2 End Sub Sub Show_change2() For i = 7 To 540 If Range("E" & i).Value <> myArray2(i - 7) Then If Not (Range("E" & i).Value = 0) And Not (Range("E" & i).Value = Chr(133)) Then Application.ScreenUpdating = False Rows(i).Copy Rows(3).PasteSpecial xlPasteValues Application.CutCopyMode = False Range("E" & i).Select Call sndPlaySound32("c:\signal", 1) Application.ScreenUpdating = True End If myArray2(i - 7) = Range("E" & i) End If Next i Call Timer End Sub Sub Timer() Dim NextTime As Date If Not bolTimer Then Exit Sub NextTime = Now + TimeValue("00:00:05") Application.OnTime NextTime, "Tabelle1.Show_Change" End Sub Sub initialize_array() For i = 7 To 540 myArray(i - 7) = Range("D" & i) Next i End Sub Sub initialize_array2() For i = 7 To 540 myArray2(i - 7) = Range("E" & i) Next i End Sub Sub Start_Ueberwachung() initialize_array initialize_array2 bolTimer = True Timer End Sub Sub Stopp_Ueberwachung() bolTimer = False End Sub

Dim myArray(540) Dim myArray2(540) Dim myValue '**** NEU **** Dim bolTimer As Boolean Sub Show_change() For i = 7 To 540 If Range("D" & i).Value <> myArray(i - 7) Then If Not (Range("D" & i).Value = 0) And Not (Range("D" & i).Value = Chr(133)) Then Application.ScreenUpdating = False Rows(i).Copy Rows(2).PasteSpecial xlPasteValues Application.CutCopyMode = False Range("D" & i).Select Call sndPlaySound32("c:\signal", 1) Application.ScreenUpdating = True End If myArray(i - 7) = Range("D" & i) End If Next i Call Show_change2 End Sub Sub Show_change2() For i = 7 To 540 If Range("E" & i).Value <> myArray2(i - 7) Then If Not (Range("E" & i).Value = 0) And Not (Range("E" & i).Value = Chr(133)) Then Application.ScreenUpdating = False Rows(i).Copy Rows(3).PasteSpecial xlPasteValues Application.CutCopyMode = False Range("E" & i).Select Call sndPlaySound32("c:\signal", 1) Application.ScreenUpdating = True End If myArray2(i - 7) = Range("E" & i) End If Next i '**** NEU **** If Range("N4").Value <> myValue Then myValue = Range("N4").Value If myValue > 10 Then Call sndPlaySound32("c:\signal", 1) End If '**** NEU **** Call Timer End Sub

Man kann genau erkennen, wie der Cursor die Spalte(in dem Falle hab ich "S" genommen) abarbeitet.
Beispiel:
Formel darin ist: =WENN(F55-R55>0;(F55-R55);"")
An genau diesr Zelle erscheint aber #Wert, weil die Ursprungszelle F55 aufgrund von DDE-Fehler "..." nur enthält.
Und schon erscheint das freundliche "Typen unverträglich"
Dieses DDE ist schon eine veraltetet Geschichte. RTD ist angekündigt, soll deutlich leistungsstärker sein.
Dim myArray(540)
Dim myArray2(540)
Dim myValue '**** NEU ****
Dim bolTimer As Boolean


Sub Show_change()
For i = 7 To 540
If Range("D" & i).Value <> myArray(i - 7) Then
If Not (Range("D" & i).Value = 0) And Not (Range("D" & i).Value = Chr(133)) Then
Application.ScreenUpdating = False
Rows(i).Copy
Rows(2).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("D" & i).Select
Call sndPlaySound32("c:\message", 1)
Application.ScreenUpdating = True
End If
myArray(i - 7) = Range("D" & i)
End If
Next i
Call Show_change2
End Sub


Sub Show_change2()
For i = 7 To 540
If Range("S" & i).Value <> myArray2(i - 7) Then
If Not (Range("S" & i).Value = 0) And Not (Range("S" & i).Value = Chr(133)) Then
Application.ScreenUpdating = False
Rows(i).Copy
Rows(3).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("S" & i).Select
Call sndPlaySound32("c:\Arb", 1)
Application.ScreenUpdating = True
End If
myArray2(i - 7) = Range("S" & i)
End If
Next i
'**** NEU ****
If Range("N4").Value <> myValue Then
myValue = Range("N4").Value
If myValue > 2000 Then Call sndPlaySound32("c:\driveby", 1)
End If
'**** NEU ****
Call Timer
End Sub


Sub Timer()
Dim NextTime As Date
If Not bolTimer Then Exit Sub
NextTime = Now + TimeValue("00:00:05")
Application.OnTime NextTime, "Tabelle2.Show_Change"
End Sub


Sub initialize_array()
For i = 7 To 540
myArray(i - 7) = Range("D" & i)
Next i
End Sub


Sub initialize_array2()
For i = 7 To 540
myArray2(i - 7) = Range("E" & i)
Next i
End Sub


Sub Start_Ueberwachung()
initialize_array
initialize_array2
bolTimer = True
Timer
End Sub


Sub Stopp_Ueberwachung()
bolTimer = False
End Sub

Sub Show_change() For i = 7 To 540 If Range("D" & i).Value <> myArray(i - 7) Then If Not (Range("D" & i).Value = 0) And Not (Range("D" & i).Value = Chr(133)) Then Application.ScreenUpdating = False Rows(i).Copy Rows(2).PasteSpecial xlPasteValues Application.CutCopyMode = False Range("D" & i).Select Call sndPlaySound32("c:\message", 1) Application.ScreenUpdating = True End If myArray(i - 7) = Range("D" & i) End If Next i Call Show_change2 End Sub

Sub Show_change2() For i = 7 To 540 If Range("S" & i).Value <> myArray2(i - 7) Then If Not (Range("S" & i).Value = 0) And Not (Range("S" & i).Value = Chr(133)) Then Application.ScreenUpdating = False Rows(i).Copy Rows(3).PasteSpecial xlPasteValues Application.CutCopyMode = False Range("S" & i).Select Call sndPlaySound32("c:\Arb", 1) Application.ScreenUpdating = True End If myArray2(i - 7) = Range("S" & i) End If Next i '**** NEU **** If Range("N4").Value <> myValue Then myValue = Range("N4").Value If myValue > 2000 Then Call sndPlaySound32("c:\driveby", 1) End If '**** NEU **** Call Timer End Sub

Beliebteste Forumthreads (12 Monate)

Nachfrage wg. VBA(Speziell Stefan Br. gerichtet)

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread