Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst Excel VB Datum prüfen

Mitglied: DasBreaker

DasBreaker (Level 1) - Jetzt verbinden

24.10.2011, aktualisiert 14:14 Uhr, 5523 Aufrufe, 11 Kommentare, 1 Danke

Hallo,
ich wurde dazu degradiert eine Excel Datei zu ertsellen die folgendes kann...

PS
Ich bin vollkommener Neuling in VB

... Man soll alle Gegenstände in eine Tabelle eintragen können und diese Gegenstände sollen den AUTOMATISCH in die jeweiligen Raumlisten bzw Wertlisten kopiert werden.
Soweit so gut und es Funktioniert auch alles super ABER an einer Sache scheiterts bei mir.

JETZT das Problem.

Ab der Zeile 26 bis Zeile 43 wird der Wert geprüft ob der Wert von bis größer kleiner ist.
Aber der soll in der SELBEN Zeile in einer anderen Spalte vorher prüfen ob ein Datum nicht vor dem 31.12.2007 ist.

Dies ist der code für das Auswerten einer Wertetabelle.

01.
Public Sub FlaechenWertAuswertung_1() 
02.
'Ausblenden der Macroaktionen 
03.
Application.ScreenUpdating = False 
04.
 
05.
'Deklarieren der Variablen 
06.
Dim cell As Range 
07.
Dim ExitFor As Integer 
08.
ExitFor = 0 
09.
 
10.
'Deklarieren des Tabellenschleifenzählerwertes 
11.
Dim tblz As Integer 
12.
Dim tblr As String 
13.
tblz = 8 
14.
tblr = "8:65536" 
15.
 
16.
'Deklarieren der Tabellenschleifenzähler 
17.
Dim tblz001 As Integer 
18.
 
19.
'Setzen der Tabellenschleifenzähler 
20.
tblz001 = tblz 
21.
 
22.
'Löschen der alten Daten 
23.
tbla001.Rows(tblr).ClearContents 
24.
 
25.
'Schreiben der neuen Daten 
26.
For Each cell In Tabelle1.Range("J8:J65536") 
27.
If cell.Value = "" Then 
28.
    ExitFor = ExitFor + 1 
29.
    If ExitFor >= 200 Then 
30.
        Exit For 
31.
    End If 
32.
End If 
33.
If Not cell.Value = "" Then 
34.
    ExitFor = 0 
35.
End If 
36.
If cell.Value >= 0.01 Then 
37.
    If cell.Value < 410 Then 
38.
        cell.EntireRow.Copy 
39.
        tbla001.Cells(tblz001, 1).PasteSpecial , Paste:=xlPasteValues 
40.
        tblz001 = tblz001 + 1 
41.
    End If 
42.
End If 
43.
Next cell 
44.
Application.ScreenUpdating = True 
45.
End Sub
Währe echt Dankbar für Hilfe

Mit freundlichen Grüßen
DasBreaker
Mitglied: MisterExpulso
24.10.2011 um 11:28 Uhr
Moin,

wie wäre es mit folgendem:

zuerst vorher im code die Variable Limit deklarieren und den Wert 31.12.2007 zuweisen:
01.
limit = Format("31.12.2007", "dd.mm.yyyy")
In der Schleife dann prüfen, ob die Differenz in Tagen größer 0 ist:
01.
If DateDiff("d", limit, cell) > 0 Then 
02.
... 
03.
Else 
04.
... 
05.
Endif
cell ist hierbei die aktuell ausgewählte Zelle.
Ich gehe davon aus, dass diese bereits als Datum formatiert ist.


Gruß,
DB
Bitte warten ..
Mitglied: DasBreaker
24.10.2011 um 11:43 Uhr
Okay Danke schonmal

jetzt habe ich schon mal die Anfrage ob Datum < > = ist ^^
Aber wie sage ich dem noch das der in der Spalte F (ist immer F) nachschauen soll?
Weil der ja in dem Moment in der Spalte J ist und den Wert ausliest oder sehe ich da gerade was falsch ich würde das jetzt so machen.


01.
For Each cell In Tabelle1.Range("J8:J65536") 
02.
If cell.Value = "" Then 
03.
    ExitFor = ExitFor + 1 
04.
    If ExitFor >= 200 Then 
05.
        Exit For 
06.
    End If 
07.
End If 
08.
If Not cell.Value = "" Then 
09.
    ExitFor = 0 
10.
End If 
11.
limit = Format("31.12.2007", "dd.mm.yyyy") 
12.
If DateDiff("d", limit, cell) > 0 Then 'statt cell muss der die Spalte F in der selben Zeile einlesen 
13.
    If cell.Value > 150.01 Then 
14.
        If cell.Value < 1000 Then 
15.
            cell.EntireRow.Copy 
16.
            tbla002.Cells(tblz001, 1).PasteSpecial , Paste:=xlPasteValues 
17.
            tblz001 = tblz001 + 1 
18.
        End If 
19.
    End If 
20.
End If 
21.
 
22.
Next cell
EDIT: wofür steht das "d" bei DateDiff?
Bitte warten ..
Mitglied: MisterExpulso
24.10.2011 um 12:41 Uhr
Ich würde das dann ein bisschen umschreiben:

01.
limit = Format("31.12.2007", "dd.mm.yyyy") 
02.
For i = 8 To 65536 
03.
cell = Tabelle1.Range("J" & i) 
04.
If cell.Value = "" Then 
05.
    ExitFor = ExitFor + 1 
06.
    If ExitFor >= 200 Then 
07.
        Exit For 
08.
    End If 
09.
End If 
10.
If Not cell.Value = "" Then 
11.
    ExitFor = 0 
12.
End If 
13.
If DateDiff("d", limit, Tabelle1.Range("F" & i)) > 0 Then 
14.
    If cell.Value > 150.01 Then 
15.
        If cell.Value < 1000 Then 
16.
            cell.EntireRow.Copy 
17.
            tbla002.Cells(tblz001, 1).PasteSpecial , Paste:=xlPasteValues 
18.
            tblz001 = tblz001 + 1 
19.
        End If 
20.
    End If 
21.
End If 
22.
Next i
PS: d bei DateDiff steht für days == Tage
Bitte warten ..
Mitglied: DasBreaker
24.10.2011 um 12:53 Uhr
Danke

Noch eine kleine Frage *für mein Verständniss*

Tabelle1.Range("F" & i)
F ist die Spalte
und i die Zeile könnte man nicht einfach auf cell abfragen in welcher Zeile cell gerade ist ?

damit es dan so ist ?
01.
'Schreiben der neuen Daten 
02.
For Each cell In Tabelle1.Range("J8:J65536") 
03.
If cell.Value = "" Then 
04.
    ExitFor = ExitFor + 1 
05.
    If ExitFor >= 200 Then 
06.
        Exit For 
07.
    End If 
08.
End If 
09.
If Not cell.Value = "" Then 
10.
    ExitFor = 0 
11.
End If 
12.
limit = Format("31.12.2007", "dd.mm.yyyy") 
13.
region = Tabelle1.Range("F" & cell.AKTUELLE ZEILE) <------------------------------------------------------------- 
14.
If DateDiff("d", limit, region) > 0 Then 
15.
    If cell.Value > 150.01 Then 
16.
        If cell.Value < 1000 Then 
17.
            cell.EntireRow.Copy 
18.
            tbla002.Cells(tblz001, 1).PasteSpecial , Paste:=xlPasteValues 
19.
            tblz001 = tblz001 + 1 
20.
        End If 
21.
    End If 
22.
End If 
23.
Next cell 
24.
Application.ScreenUpdating = True 
25.
End Sub
Bitte warten ..
Mitglied: MisterExpulso
24.10.2011 um 12:59 Uhr
Das könnte theoretisch gehen.
Ich weiß aber nicht, ob vba dafür eine Funktion bietet.

Gruß,
DB
Bitte warten ..
Mitglied: DasBreaker
24.10.2011 um 13:33 Uhr
Warte mal ich habe doch die aktuelle Zeile
sihe tblz001 ???
könnte es sein das ich sowas schon unwissentlich habe ?
Bitte warten ..
Mitglied: DasBreaker
24.10.2011 um 13:38 Uhr
OKAY
HABE ES HIN BEKOMMEN DANKÖÖÖÖÖÖ :D

Auch wenn ich das < und > dei DiffDate austauchen musste

hier der code

01.
Public Sub FlaechenWertAuswertung_1() 
02.
'Ausblenden der Macroaktionen 
03.
Application.ScreenUpdating = False 
04.
 
05.
'Deklarieren der Variablen 
06.
Dim cell As Range 
07.
Dim ExitFor As Integer 
08.
ExitFor = 0 
09.
 
10.
'Deklarieren des Tabellenschleifenzählerwertes 
11.
Dim tblz As Integer 
12.
Dim tblr As String 
13.
tblz = 8 
14.
tblr = "8:65536" 
15.
 
16.
'Deklarieren der Tabellenschleifenzähler 
17.
Dim tblz001 As Integer 
18.
 
19.
'Setzen der Tabellenschleifenzähler 
20.
tblz001 = tblz 
21.
 
22.
'Löschen der alten Daten 
23.
tbla001.Rows(tblr).ClearContents 
24.
 
25.
'Schreiben der neuen Daten 
26.
For Each cell In Tabelle1.Range("J8:J65536") 
27.
If cell.Value = "" Then 
28.
    ExitFor = ExitFor + 1 
29.
    If ExitFor >= 200 Then 
30.
        Exit For 
31.
    End If 
32.
End If 
33.
If Not cell.Value = "" Then 
34.
    ExitFor = 0 
35.
End If 
36.
limit = Format("31.12.2007", "dd.mm.yyyy") 
37.
If DateDiff("d", limit, Tabelle1.Range("F" & tblz001)) < 0 Then 
38.
    If cell.Value >= 0.01 Then 
39.
        If cell.Value < 410 Then 
40.
            cell.EntireRow.Copy 
41.
            tbla001.Cells(tblz001, 1).PasteSpecial , Paste:=xlPasteValues 
42.
            tblz001 = tblz001 + 1 
43.
        End If 
44.
    End If 
45.
End If 
46.
Next cell 
47.
Application.ScreenUpdating = True 
48.
End Sub
EDIT:
es muss...
01.
If DateDiff("d", limit, Tabelle1.Range("F" & tblz001)) <= 0 Then 
... sein da sonst der 31.12. nicht mit berechnet wird :D


Vielen Dank
Mit freundlichen Grüßen
DasBreaker
Bitte warten ..
Mitglied: DasBreaker
24.10.2011 um 14:17 Uhr
*arg*

vieleicht sollte man vorher ausgiebig Testen bevor man sagt es Klappt.

leider habe ich iwo mit dem Datum immernoch ein Fehler.
EINGABE

x = was ausgegeben werden MUSS

150,00 € x
31.12.2006 150,00 € x
31.12.2007 150,00 € x
01.01.2008 150,00 €
01.01.2009 150,00 €
500,00 €
31.12.2006 500,00 €
31.12.2007 500,00 €
01.01.2008 500,00 €
01.01.2009 500,00 €

AUSGABE
150,00 €
31.12.07 150,00 €
Bitte warten ..
Mitglied: DasBreaker
24.10.2011 um 14:44 Uhr
[leer] 150,00 €
31.12.2006 150,00 €
31.12.2007 150,00 €
01.01.2008 150,00 €
01.01.2009 150,00 €
[leer] 500,00 €
31.12.2006 500,00 €
31.12.2007 500,00 €
01.01.2008 500,00 €
01.01.2009 500,00 €
OKAY das habe ich hin bekommen war nen FAIL meiner seits
Aber nun zum nächsten Problem:
zB die Werte oben sind die testwerte

und das ist der Code

01.
limit = Format("31.12.2007", "dd.mm.yyyy") 
02.
If DateDiff("d", limit, Tabelle1.Range("F" & tblz001)) > 0 Then ' Alles was über dem 31.12.2007 ist 
03.
    If cell.Value >= 150.01 Then 'Alles was größer oder gleich 150,01€ ist 
04.
        If cell.Value <= 1000 Then 'Alles was kleiner oder gleich 1000€ ist 
05.
            cell.EntireRow.Copy 
06.
            tbla002.Cells(tblz001, 1).PasteSpecial , Paste:=xlPasteValues 
07.
            tblz001 = tblz001 + 1 
08.
        End If 
09.
    End If 
10.
End If
Aber die ausgabe ist leer o.O
Was mache ich falsch ?
Bitte warten ..
Mitglied: DasBreaker
24.10.2011 um 17:32 Uhr
OK ich habe den Fehler doch gefunden Quellcode gibs morgen da ich die erlösung 5 min vor arbeitsschluss gefunden habe.
Bitte warten ..
Mitglied: DasBreaker
25.10.2011 um 07:10 Uhr
Zitat von DasBreaker:
OK ich habe den Fehler doch gefunden Quellcode gibs morgen da ich die erlösung 5 min vor arbeitsschluss gefunden habe.
Guten Morgen wie versprochen der Code

01.
Public Sub FlaechenWertAuswertung_1() 
02.
'Ausblenden der Macroaktionen 
03.
Application.ScreenUpdating = False 
04.
 
05.
'Deklarieren der Variablen 
06.
Dim cell As Range 
07.
Dim ExitFor As Integer 
08.
ExitFor = 0 
09.
 
10.
'Deklarieren des Tabellenschleifenzählerwertes 
11.
Dim tblz As Integer 
12.
Dim tblr As String 
13.
tblz = 8 
14.
tblr = "8:65536" 
15.
 
16.
'Deklarieren der Tabellenschleifenzähler 
17.
Dim tblz001 As Integer 
18.
 
19.
'Setzen der Tabellenschleifenzähler 
20.
tblz001 = tblz 
21.
 
22.
'Löschen der alten Daten 
23.
tbla001.Rows(tblr).ClearContents 
24.
 
25.
'Schreiben der neuen Daten 
26.
For Each cell In Tabelle1.Range("J8:J65536") 
27.
If cell.Value = "" Then 
28.
    ExitFor = ExitFor + 1 
29.
    If ExitFor >= 200 Then 
30.
        Exit For 
31.
    End If 
32.
End If 
33.
If Not cell.Value = "" Then 
34.
    ExitFor = 0 
35.
End If 
36.
limit = Format("31.12.2007", "dd.mm.yyyy") 
37.
If Not Tabelle1.Range("F" & tblz) = "" Then 
38.
    If DateDiff("d", limit, Tabelle1.Range("F" & tblz)) <= 0 Then 
39.
        If cell.Value >= 0.01 Then 
40.
            If cell.Value < 410 Then 
41.
                cell.EntireRow.Copy 
42.
                tbla001.Cells(tblz001, 1).PasteSpecial , Paste:=xlPasteValues 
43.
                tblz001 = tblz001 + 1 
44.
            End If 
45.
        End If 
46.
    End If 
47.
End If 
48.
tblz = tblz + 1 
49.
Next cell 
50.
Application.ScreenUpdating = True 
51.
End Sub
Mit freundlichen Grüßen
DasBreaker
Bitte warten ..
Ähnliche Inhalte
Batch & Shell
Excel Prüfen
Frage von michi-ffmBatch & Shell

Hallo Zusammen, komme leider nicht weiter und hoffe jemand hat eine Idee. Ich habe ein Skript das wunderbar funktionierte, ...

VB for Applications
VB Skript Excel Datei
gelöst Frage von FragerVB for Applications3 Kommentare

Hallo Zusammen, Ich brauche eure Hilfe. Ich habe eine Datei 1.xlsx nun brauche ich ein Skript, was die Datei ...

Microsoft Office

Denkanstoß Datums- und Prozentrechung in Excel

gelöst Frage von flulukMicrosoft Office5 Kommentare

Hallo, ich stehe irgendwie gerade auf dem Schlauch was Excel angeht. Und zwar habe ich eine Tabelle mit einem ...

Microsoft Office

Excel Online Datum

gelöst Frage von MegaGigaMicrosoft Office10 Kommentare

Hallihallo Ich habe heute morgen mal begonnen Office Online ein wenig genauer anzuschauen. Nun habe ich ein Excel Sheet, ...

Neue Wissensbeiträge
Humor (lol)

Das neue Miniatur Wunderland OFFICIAL VIDEO - worlds largest model railway - railroad

Information von StefanKittel vor 4 StundenHumor (lol)

Hallo, wer noch nie im Miniatur Wunderland war, sollte es dringend mal nachholen. Es gibt eine neues Video. Viele ...

Exchange Server

Exchange 2010-2019 Sicherheitslücke durch Regkey löschen schließen

Information von sabines vor 15 StundenExchange Server1 Kommentar

Unter ist eine Lücke im Exchange 2010-2019 beschrieben, die durch das Löschen eines reg keys geschlossen werden kann. In ...

Windows Server
Erneutes Release von WS2019 und Win10 v1809
Tipp von IT-Pro vor 1 TagWindows Server3 Kommentare

Hi, nachdem der Windows Server 2019 und Windows 10 in der Version 1809 aufgrund von verschwinden von Dateien nach ...

CPU, RAM, Mainboards
Spectre Update Tool für ältere PCs
Information von sabines vor 1 TagCPU, RAM, Mainboards6 Kommentare

Mit Hilfe eines Tools wird der betreffende PC permanent von einem USB Stick gestartet, der ein passendes Microcode Update ...

Heiß diskutierte Inhalte
Java
Testautomatisierung
gelöst Frage von WPFORGEJava15 Kommentare

Hallo, nehmen wir an, es gibt eine Webseite mit einer Karte und einem Suchfeld. Nun wird in das Suchfeld ...

Viren und Trojaner
Office365 Trojaner Analyse
Frage von ZeppelinViren und Trojaner12 Kommentare

Liebe Community, ich wende mich an euch, um mehr über den Office365 Trojaner zu erfahren, welcher grade seine Runden ...

Exchange Server
PST Datei enthält weder Betreff noch Absender
gelöst Frage von SSamuelExchange Server10 Kommentare

Hallo zusammen, ich versuche aus einer wiederhergestellten Exchange (SBS2011) .EDB mit dem Programm "Kernel for Exchange von Nucleus" eine ...

Netzwerke
Anfänger in SSL Zertifikat
Frage von Florian961988Netzwerke10 Kommentare

Guten Morgen liebes Forum, ich habe mal Fragen zum Thema SSL zertifikat verlängern/bzw ändern! Aber von vorne wir haben ...