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, 5539 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
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, ...

Microsoft Office
Datum berechnen Excel
gelöst Frage von Gast2015Microsoft Office3 Kommentare

Hallo :-), Ich hätte ein Frage zu Excel und zwar habe ich zwei Datumsangaben (A1+A2) und bräuchte in einem ...

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

Excel Nachfrage: Datum aus Spalte ausgeben

Frage von PronMasterMicrosoft Office2 Kommentare

Hallo Zusammen, ich habe folgende Aufgabe bekommen: Wir haben eine Excel in der in einer Spalte das Ablaufdatum von ...

Neue Wissensbeiträge
LAN, WAN, Wireless

Cisco Mikrotik VPN Standort Vernetzung mit dynamischem Routing

Anleitung von aqui vor 2 StundenLAN, WAN, Wireless

1. Allgemeine Einleitung Das nachfolgende Tutorial ist eine Fortführung der hier bei Administrator.de schon bestehenden VPN Tutorials und beschreibt ...

Windows Mobile

Support für Windows Mobile endet im Dezember 2019

Information von transocean vor 1 TagWindows Mobile

Moin, Microsoft empfiehlt als Alternative den Umstieg auf iOS oder Android, wie man hier lesen kann. Gruß Uwe

Internet

Kommentar: Bundesregierung erwägt Ausschluss von Huawei im 5G-Netz - Unsere Presse wird immer sensationsgieriger

Information von Frank vor 3 TagenInternet5 Kommentare

Hier mal wieder ein schönes Beispiel für fehlgeleiteten Journalismus und Politik zugleich. Da werden aus Gerüchten plötzlich Fakten, da ...

Windows 10

Netzwerk-Bug in allen Windows 10-Versionen durch Januar 2019-Updates

Information von kgborn vor 3 TagenWindows 101 Kommentar

Nur ein kurzer Hinweis für Admins, die Windows 10-Clients im Portfolio haben. Mit den Updates vom 8. Januar 2019 ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
Temporäre WLAN Verbindung für AD-Login
Frage von Christian.WidauerLAN, WAN, Wireless15 Kommentare

Hallo zusammen, ich weiß leider nicht unter welchem Begriff ich dafür suchen muss, daher habe ich bisher leider nichts ...

LAN, WAN, Wireless
Bekannte Drosselungen bei Providern ?
Frage von HenereLAN, WAN, Wireless15 Kommentare

Servus zusammen, in bereits angefangen, aber ich hoffe dass der Beitrag hier mehr Informationen bringt. Sind Portdrosselungen bzw gezielte ...

Netzwerkmanagement
Reverse Proxy für TCP und UDP Anfragen
gelöst Frage von flxklsNetzwerkmanagement14 Kommentare

Hallo zusammen, ich besitze einen Rootserver, der nur eine öffentliche IP besitzt und auf dem mehrere VMs laufen. Da ...

Netzwerkmanagement
Server bauen
Frage von JugendringNetzwerkmanagement11 Kommentare

Moin Moin, wir, der Jugendring sind ein ständig wachsender Verein mit vielen Unterprojekten. Da liegt es nah, dass wir ...