Supportnet / Forum / Tabellenkalkulation
Werte automatisch kopieren
Frage
guten Abend zusammen
Wieder mal ein Problem , wo ich mit meinem VBA - Latein am Ende bin
Folgendes
In Spalte A steht Formel DATEDIF in den dazugehörenden Zeilen stehen Werte
Wen die Tagesdifferenz >= 90 Tage ist sollen die Werte der Zeilen automatisch Rot blinken und in Tabelle 2 kopiert werden (es soll auch eine mehrfachauswahl möglich sein )
wr kann mir weiterhelfen
danke im vorraus
Antwort 1 von Saarbauer
Hallo,
einen Link für deinen Fall, ich hoffe es funktioniert
http://www.schmittis-page.de/index.html?/excel/faq/f5.htm
Gruß
Helmut
einen Link für deinen Fall, ich hoffe es funktioniert
http://www.schmittis-page.de/index.html?/excel/faq/f5.htm
Gruß
Helmut
Antwort 2 von Ahnan
Hallo,
hier ein Programm, welches alle Werte (>= 90) der Spalte A (Zeile 1 bis 100> kann man ändern) v. Tabelle1 rot blinken lässt. Ausserdem wird jeweils die Zeile der gefundenen Werte in Tabelle2 gelistet. Das ganze funzt aber nur, wenn die Werte der Spalte A nicht durch eine Formel entstanden sind ! Ist dies der Fall (wegen Datedif) muss die Spalte A erst in eine nicht genutzte, freie Spalte kopiert werden u. der Suchbereich entsprechend in den Makros geändert werden (Ein bisserl mehr Arbeit).
3 Makros:
Option Explicit
Public ET As Date
Public Zelle
Public RaZelle As Range
Public BoFarbe As Boolean
Public i, iRow As Long
Sub Werte_suchen()
Application.ScreenUpdating = False
iRow = 1
For i = 1 To 100
If Cells(i, 1).Value >= 90 Then Sheets("Tabelle2").Rows(iRow).Value = Sheets("Tabelle1").Rows(i).Value: iRow = iRow + 1
Next i
Call Blinken
Application.ScreenUpdating = True
End Sub
Sub Blinken()
For Each RaZelle In ThisWorkbook.Worksheets("Tabelle1").Range("A1:A100")
If IsNumeric(RaZelle) Then
If RaZelle >= 90 Then
If BoFarbe = False Then
RaZelle.Interior.ColorIndex = 3
Else
RaZelle.Interior.ColorIndex = xlNone
End If
End If
End If
Next RaZelle
BoFarbe = Not BoFarbe
ET = Now + TimeValue("00:00:01")
Application.OnTime ET, "Blinken"
End Sub
Sub Blinken_Ende()
On Error Resume Next
Application.OnTime EarliestTime:=ET, Procedure:="Blinken", Schedule:=False
ET = ""
For Each RaZelle In ThisWorkbook.Worksheets("Tabelle1").Range("A1:A100")
If IsNumeric(RaZelle) Then
If RaZelle >= 90 Then
RaZelle.Interior.ColorIndex = xlNone
End If
End If
Next RaZelle
End Sub
Sub Werte_suchen musst du einer Schaltfläche zuweisen. Sub Blinken_Ende ebenfalls (damit man das Blinken abstellen kann) !
Solltest du es nicht hinbekommen, kann ich dir die Datei auch per Mail schicken. Oder du schickst mir deine Datei u. ich schau mal drüber.
Meine Email:
held1233@aol.com
MfG
hier ein Programm, welches alle Werte (>= 90) der Spalte A (Zeile 1 bis 100> kann man ändern) v. Tabelle1 rot blinken lässt. Ausserdem wird jeweils die Zeile der gefundenen Werte in Tabelle2 gelistet. Das ganze funzt aber nur, wenn die Werte der Spalte A nicht durch eine Formel entstanden sind ! Ist dies der Fall (wegen Datedif) muss die Spalte A erst in eine nicht genutzte, freie Spalte kopiert werden u. der Suchbereich entsprechend in den Makros geändert werden (Ein bisserl mehr Arbeit).
3 Makros:
Option Explicit
Public ET As Date
Public Zelle
Public RaZelle As Range
Public BoFarbe As Boolean
Public i, iRow As Long
Sub Werte_suchen()
Application.ScreenUpdating = False
iRow = 1
For i = 1 To 100
If Cells(i, 1).Value >= 90 Then Sheets("Tabelle2").Rows(iRow).Value = Sheets("Tabelle1").Rows(i).Value: iRow = iRow + 1
Next i
Call Blinken
Application.ScreenUpdating = True
End Sub
Sub Blinken()
For Each RaZelle In ThisWorkbook.Worksheets("Tabelle1").Range("A1:A100")
If IsNumeric(RaZelle) Then
If RaZelle >= 90 Then
If BoFarbe = False Then
RaZelle.Interior.ColorIndex = 3
Else
RaZelle.Interior.ColorIndex = xlNone
End If
End If
End If
Next RaZelle
BoFarbe = Not BoFarbe
ET = Now + TimeValue("00:00:01")
Application.OnTime ET, "Blinken"
End Sub
Sub Blinken_Ende()
On Error Resume Next
Application.OnTime EarliestTime:=ET, Procedure:="Blinken", Schedule:=False
ET = ""
For Each RaZelle In ThisWorkbook.Worksheets("Tabelle1").Range("A1:A100")
If IsNumeric(RaZelle) Then
If RaZelle >= 90 Then
RaZelle.Interior.ColorIndex = xlNone
End If
End If
Next RaZelle
End Sub
Sub Werte_suchen musst du einer Schaltfläche zuweisen. Sub Blinken_Ende ebenfalls (damit man das Blinken abstellen kann) !
Solltest du es nicht hinbekommen, kann ich dir die Datei auch per Mail schicken. Oder du schickst mir deine Datei u. ich schau mal drüber.
Meine Email:
held1233@aol.com
MfG
Antwort 3 von UGSHAN
Endschuldigt die verspätung
Nochmals Danke für die Tips
Werde sie ausprobieren
Wenn es nicht funzt melde ich mich nochmals
Danke
Nochmals Danke für die Tips
Werde sie ausprobieren
Wenn es nicht funzt melde ich mich nochmals
Danke