Supportnet Computer
Planet of Tech

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

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

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