Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Datum suchen mit nachfolgender Bedingung

Betrifft: Datum suchen mit nachfolgender Bedingung von: Chris
Geschrieben am: 17.11.2014 14:08:43

Hallo Leute,

ich habe folgendes Problem. Ich möchte mit einem Makro ein bestimmtes Datum in einer anderen Excelmappe suchen. Sobald das gefundene Datum übereinstimmt, soll der Inhalt des Tabellenblattes kopiert werden. Das gefundene Datum darf maximal 3 Tage älter sein als das Suchdatum.
Wenn das gefundene Datum älter ist als 3 Tage, soll der ganze Sub abgebrochen werden

Ich habe mich mit folgendem Code probiert:


Sub OpRisk_getNewData()
Dim objTo_find1 As Range, objTo_find2 As String
Dim objTemp As Range, objTo_find3 As String, objTo_find4 As String
Dim objData As Range


If Dir(Range("OpRisk_ImportPath")) = "" Then
        MsgBox "A source for new Reference Data is not available. Please check path.", vbOKOnly  _
 _
+ vbCritical
        Exit Sub
    
    End If
Set objTo_find1 = Range("next_due_date_OpRisk")
objTo_find2 = DateAdd("d", 1, objTofind1)
objTo_find3 = DateAdd("d", 2, objTofind1)
objTo_find4 = DateAdd("d", 3, objTofind1)
Set objTemp = ActiveSheet.Range("A1:I2").Find(objTo_find1)
If objTemp Is Nothing Then
    Set objTemp = ActiveSheet.Range("A1:I2").Find(objTo_find2)
    If objTemp Is Nothing Then
        Set objTemp = ActiveSheet.Range("A1:I2").Find(objTo_find3)
        If objTemp Is Nothing Then
            Set objTemp = ActiveSheet.Range("A1:I2").Find(objTo_find4)
            If objTemp Is Nothing Then
                MsgBox "No valid report date found"
                Exit Sub
            End If
        End If
    End If
End If
Windows("141117_EWSTool_v02.xlsm").Activate
                Sheets("OpRisk Reference Data").Select
                Rows("2:2").Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.ClearContents
                Windows("KRIs Monitoring Data_2014.09.xlsx").Activate
                Range("A4:I4").Select
                Range(Selection, Selection.End(xlDown)).Select
                Application.CutCopyMode = False
                Selection.Copy
                Windows("141117_EWSTool_v02.xlsm").Activate
                Sheets("OpRisk Reference Data").Select
                Range("A2").Select
                ActiveSheet.Paste
                Worksheets("OpRisk").Range("I11") = Date
                Workbooks("KRIs Monitoring Data_2014.09.xlsx").Close


MsgBox "Import completed"

End Sub

Ich denke es ist nur ein dummer Anfängerfehler...

Ich hoffe ihr könnt mir weiterhelfen

Danke
Chris

  

Betrifft: AW: Datum suchen mit nachfolgender Bedingung von: Chris
Geschrieben am: 17.11.2014 14:19:42

Vielleicht sollte ich noch ergänzen, dass der Code zwar durchläuft, aber nie stoppt, auch wenn das Datum viel älter als 3 Tage ist...

Sprich das Makro kopiert sich IMMER die Daten.


  

Betrifft: AW: Datum suchen mit nachfolgender Bedingung von: Rudi Maintaire
Geschrieben am: 17.11.2014 14:28:59

Hallo,
du suchst ein Datum aber dein Suchbegriff ist ein Text.
Versuchs mal so:

Sub OpRisk_getNewData()
  Dim dteToFind As Date
  Dim objTemp As Range
  Dim objData As Range
  
  
  If Dir(Range("OpRisk_ImportPath")) = "" Then
    MsgBox "A source for new Reference Data is not available. Please check path.", vbOKOnly _
 _
    + vbCritical
    Exit Sub
    
  End If
  dteToFind = Range("next_due_date_OpRisk")
  For i = 0 To 3
    Set objTemp = ActiveSheet.Range("A1:I2").Find(what:=dteToFind - i, LookIn:=xlValues)
    If Not objTemp Is Nothing Then
      Exit For
    End If
  Next
  If objTemp Is Nothing Then Exit Sub
  '....

Gruß
Rudi


  

Betrifft: AW: Datum suchen mit nachfolgender Bedingung von: Chris
Geschrieben am: 17.11.2014 14:52:08

Hi Rudi,
danke für die schnelle Antwort. Nun beschwert er sich aber leider bei dteToFind = Range("next_due_date_OpRisk") und meint Laufzeitfehler 1004. Evtl. kann ich die Variable hier nicht als Date deklarieren?!

Grüße
Chris


  

Betrifft: AW: Datum suchen mit nachfolgender Bedingung von: Rudi Maintaire
Geschrieben am: 17.11.2014 14:53:58

Hallo,
dann steht kein Datum drin.

Gruß
Rudi


  

Betrifft: AW: Datum suchen mit nachfolgender Bedingung von: Chris
Geschrieben am: 17.11.2014 14:58:59

Doch, ich habe erst 01.09.2014 in die Zelle eingegeben und diese dann auf ein englisches Datumsformat formatiert (2014-09-01). Oben in der Funktionszeile steht immer noch 01.09.2014.

Gruß
Chris


  

Betrifft: Fehler 1004 von: Rudi Maintaire
Geschrieben am: 17.11.2014 15:13:23

Hallo,
den Bereich gibt es nicht in der aktiven Mappe.

Gruß
Rudi


  

Betrifft: AW: Fehler 1004 von: Chris
Geschrieben am: 17.11.2014 15:17:40

Hi Rudi,
ich kann mir auch nicht vorstellen, dass es daran liegt...
Ich mal einen Ausschnitt meiner Excel Datei hochgeladen. Dazu noch die zu Importierenden Datei...

https://www.herber.de/bbs/user/93823.xlsm
https://www.herber.de/bbs/user/93824.xlsx

Beste Grüße
Chris


  

Betrifft: AW: Fehler 1004 von: Chris
Geschrieben am: 17.11.2014 15:17:52

Hi Rudi,
ich kann mir auch nicht vorstellen, dass es daran liegt...
Ich mal einen Ausschnitt meiner Excel Datei hochgeladen. Dazu noch die zu Importierenden Datei...

https://www.herber.de/bbs/user/93823.xlsm
https://www.herber.de/bbs/user/93824.xlsx

Beste Grüße
Chris


  

Betrifft: der Fall ist klar von: Rudi Maintaire
Geschrieben am: 17.11.2014 15:25:23

Hallo,
du öffnest erst ein anderes Workbook. Somit ist dieses aktiv und darin gibt es den Bereich nicht.

Gruß
Rudi


  

Betrifft: AW: der Fall ist klar von: Chris
Geschrieben am: 17.11.2014 15:45:18

Hi Rudi,
nun besetze ich die Variable bevor ich das neue Workbook aufmache
dteToFind = Range("next_due_date_OpRisk")
Workbooks.Open Filename:=Range("OpRisk_ImportPath")

Nun endet der Sub nach dem öffnen der neuen Datei?! auch wenn ich noch eine Message Box "no valid date found" hinzufüge ?!

hier nochmal mein gesamter Code:

Sub OpRisk_getNewData()
Dim objTo_find1 As Range, objTo_find2 As String
Dim objTemp As Range, objTo_find3 As String, objTo_find4 As String
Dim objData As Range
Dim dteToFind As Date



If Dir(Range("OpRisk_ImportPath")) = "" Then
        MsgBox "A source for new Reference Data is not available. Please check path.", vbOKOnly  _
+ vbCritical
        Exit Sub
    
    End If
    
dteToFind = Range("next_due_date_OpRisk")
Workbooks.Open Filename:=Range("OpRisk_ImportPath")

  For i = 0 To 3
    Set objTemp = ActiveSheet.Range("A1:I2").Find(what:=dteToFind - i, LookIn:=xlValues)
    If Not objTemp Is Nothing Then
      Exit For
    End If
  Next
  If objTemp Is Nothing Then
  Exit Sub
    MsgBox "no valid report date found"
   Else

                Windows("141117_EWSTool_v02.xlsm").Activate
                Sheets("OpRisk Reference Data").Select
                Rows("2:2").Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.ClearContents
                Windows("KRIs Monitoring Data_2014.09.xlsx").Activate
                Range("A4:I4").Select
                Range(Selection, Selection.End(xlDown)).Select
                Application.CutCopyMode = False
                Selection.Copy
                Windows("141117_EWSTool_v02.xlsm").Activate
                Sheets("OpRisk Reference Data").Select
                Range("A2").Select
                ActiveSheet.Paste
    Worksheets("OpRisk").Range("I11") = Date
    Workbooks("KRIs Monitoring Data_2014.09.xlsx").Close

End If
MsgBox "Import completed"

End Sub


Grüße
Chris


  

Betrifft: o gott o gott von: Rudi Maintaire
Geschrieben am: 17.11.2014 15:51:54

Hallo,
du beendest die Sub bevor du die Msgbox anzeigst.

  If objTemp Is Nothing Then
  Exit Sub
    MsgBox "no valid report date found"
   Else
Gruß
Rudi


  

Betrifft: AW: o gott o gott von: Chris
Geschrieben am: 17.11.2014 16:02:30

ok das war wirklich doof :) Aber trotzdem ändert das nichts daran, dass der Code jedesmal zum vorzeitigen Ende kommt. Auch wenn das Suchdatum genau auf das Datum in der Importdatei passt.

Du kannst es ja mal mit den Dateien probieren die ich hochgeladen habe...
Wenn du es selber mal testest, erkennst du bestimmt gleich woran das hängen könnte. Vielleicht habe ich da noch ein dummes Detail vergessen

danke schon mal und Grüße
Chris


  

Betrifft: AW: o gott o gott von: Rudi Maintaire
Geschrieben am: 17.11.2014 16:29:21

Hallo,

  For i = 0 To 3
    Set objTemp = Range("A1:I2").Find(what:=Format(dteToFind - i, "YYYY-MM-DD"), LookIn:= _
xlValues)
    If Not objTemp Is Nothing Then
      Exit For
    End If
  Next

Gruß
Rudi


  

Betrifft: AW: o gott o gott von: Chris
Geschrieben am: 17.11.2014 17:06:20

Hi Rudi,
ich glaub wir haben es fast geschafft. Das Datum erkennt er nun und findet es auch, wenn Suchdatum genau das Datum in der Importdatei ist. Sobald ich nun aber anstatt 01.09.2014, den 31.08.2014 eingebe, funktioniert es nicht mehr. Wahrscheinlich zieht er nur die Tage ab und wechselt nicht auf den August???!!
Daher hatte ich mal diesen Code hier ausprobiert. Hier stört er sich aber an dem DateSerial?!

dteToFind = Range("next_due_date_OpRisk")
Workbooks.Open Filename:=Range("OpRisk_ImportPath")
  For i = 0 To 3
    Set objTemp = Range("A1:I2").Find(what:=Format(DateSerial(Year(dteToFind), Month(dteToFind), _
 Day(dteToFind) - i, "YYYY-MM-DD")), LookIn:=xlValues)
    If Not objTemp Is Nothing Then
      Exit For
    End If
  Next
Du hattest hierzu auch mal eine ganz interessante Konstruktion. Dies läuft aber auch nur mit dem DateSerial...


Grüße
Chris


  

Betrifft: AW: o gott o gott von: Rudi Maintaire
Geschrieben am: 17.11.2014 22:00:56

Hallo,
schieres Missverständnis.
+i statt -i.


Gruß
Rudi


  

Betrifft: AW: o gott o gott von: Chris
Geschrieben am: 18.11.2014 10:30:39

Hi Rudi,
ja war ein super Missverständnis. Hatte selbst den Datumsdreher bei mir drin. Also jetzt funktioniert es so wie ich mir das vorstelle. Dadurch dass die Variable als Datum deklariert ist, erkennt er nun auch die Monatswechsel (wunderbar!!!). Du bist ein Crack, Rudi!!!

Nun würde mich natürlich noch interessieren, wie man direkt auf einen vergangenen Monat und Woche zurückgreift. Könnte man natürlich bei Woche einfach i=-7 aber das ist natürlich wenig elegant.

Hast du da noch ein Code Beispiel. Da ist man mit Search Date wahrscheinlich gut beraten?!

Danke aber erst mal für das lösen meines erstem Problems und deiner langen Geduld!

Grüße
Chris


 

Beiträge aus den Excel-Beispielen zum Thema "Datum suchen mit nachfolgender Bedingung"