Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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

Frage Entwicklung VB for Applications

Mitglied: DasBreaker

DasBreaker (Level 1) - Jetzt verbinden

24.10.2011, aktualisiert 14:14 Uhr, 5276 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 ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(5)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Microsoft Office
gelöst In Excel das Datum aus einer Registerlasche in einer Formel verwenden (7)

Frage von michael1306 zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel Makro : Erst prüfen bei erfolgreicher IF einen Wert überschreiben (4)

Frage von Matze1508 zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel: Text in Zellbereich prüfen mit Vergleichstext ggf. mit Exact-Funktion (5)

Frage von Michi1 zum Thema Microsoft Office ...

Microsoft Office
gelöst EXCEL Bedingte Formatierung wenn bestimmtes Jahr im Datum ist (6)

Frage von Hobi84 zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (17)

Frage von Unwichtig zum Thema Netzwerkmanagement ...