19.03.2014, aktualisiert am 08.04.2014

6987

Excel nur kopieren wenn Datum nicht schon vorhanden VBA

Hallo zusammen,

folgendes Aufgabe:
In einer ExceltabelleEingabe steht im Blatt2 A3 ein Datum. Dieses soll nun mit der anderen ExceltabelleAusgabe im Blatt3 SpalteB verglichen werden. Wenn es das Datum dort noch nicht gibt, sollen aus der ExceltabelleEingabe aus dem Blatt3 die Zellen A1:A5 in die ExecltabelleAusgabe in die nächste freie Zeile ab SpalteB kopiert werden, wenn es das Datum dort schon gibt soll eine Meldung kommen "Datum schon vorhanden" und ein Rücksprung ganz an den Anfag des Codes gehen um den gesamten Ablauf neu zu starten. Teilweise bekomme ich es zwar hin das die Meldung kommt, aber der Rücksprung klappt nicht bzw. wenn das Datum nicht vorhanden ist wird trotzdem leider nicht kopiert.
Ich hoffe mich einigemaßen vertändlich ausgedrückt zu haben.
Schon mal Dank an die VBA-Spezialisten.

Gruß
hugo

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 233072

Url: https://administrator.de/contentid/233072

Ausgedruckt am: 22.11.2024 um 04:11 Uhr

12 Kommentare

Neuester Kommentar

Hallo,

Zitat von @hugoundertaker:
Ich hoffe mich einigemaßen vertändlich ausgedrückt zu haben.

Nein. Netter Aufsatz, aber was sollen wir damit und welche Planquadratkarten hast du geraucht?

Schon mal Dank an die VBA-Spezialisten.

Für? Solltest du hier Hilfe haben wollen, so solltest du es uns auch tatsächlich sagen bzw. uns deine Frage auch tatsächlich stellen und nicht uns einfach etwas lesestoff hinschmeßen.

Und den zugehörigen Quellcode wirst du mitliefern müssen, damit wir wissen was du den tatsächlich dort tust bzw. erahnen können was du denn tun willst... Code tags Formatierungen in den Beiträgen sind für den Quellcode nützlich.

Gruß,
Peter

Hallo Peter,

Frage war, wie geht das mit dem Rücksprung zur Inputbox am Anfang des Codes bzw. warum kopiert er nicht wenn das Datum nicht vorhanden ist?
Hier nun der Hauptcode:

Private Sub Workbook_Open()
Arbeitsblattloeschen
' Eingabebox für Datum um richte Datei zu finden  
Dim sTxt As String, sPrompt As String, sDefault As String, sPath As String
   Do
   sPath = "Y:\Arbeitsordner\"  
   sPrompt = "Eingangsdatum eingeben:" & vbLf & _  
   vbLf & _
   "Nutzen Sie bitte folgende Syntax:" & vbLf & _  
   "'yyyy_mm_dd' oder das 'Abbruch'-Feld zum verlassen!"  
   sDefault = Format("yyyy_mm_dd")  
   sTxt = InputBox(prompt:=sPrompt, Default:=sDefault)
   If sTxt = "Ende" Then Exit Sub  
   If StrPtr(sTxt) = 0 Then GoTo Ende
   If sTxt = "" Then  
   MsgBox "Kein gültiges Datumsformat!"  
   ElseIf Dir(sPath & sTxt & ".txt") = "" Then  
   MsgBox "Datei " & sTxt & ".txt nicht vorhanden!"  
   Else
   Exit Do
   End If
   Loop  
    Sheets("Tabelle1").Activate  
Range("A1").Select     
   ' Import der Daten  
      With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;Y:\Arbeitsordner\" & sTxt & ".txt", Destination:=Range("$A$1") _  
        )
        .Name = "2014_02_24"  
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 9, 9, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Application.DisplayAlerts = False       
              Pivotaktu ' Pivottabelle auf aktuellen Stand bringen    
      Windows("Eingabe.xlsm").Activate  
    Range("A1").Select          
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, FieldInfo:=Array(0, 5) ' Werte in Spalte A von Standart auf Datum ändern      
Datumscheck ' Prüfen ob Datum schon vorhanden    
Arbeitsblattloeschen
Schluss ' Ende  
Exit Sub
Ende:
 Application.Quit
 ActiveWorkbook.Save
 ActiveWorkbook.Close
 Application.DisplayAlerts = False  
    End Sub

Und hier das Makro zum prüfen bzw. kopieren:

Sub Datumscheck()
'  
' Datumscheck Makro  
'  
Dim EintragCheck1 As Variant
Dim eintragCheck2 As Variant
EintragCheck1 = Sheets("Blatt2").Cells(1, 1).Value  
Application.ScreenUpdating = False
Dim leereZeile
Sheets("Blatt2").Range("A1:A4").Copy  
Workbooks.Open Filename:="Y:\Arbeitsordner\Ausgabe.xlsx"  
  Windows("Ausgabe.xlsx").Activate  
  Worksheets("Blatt3").Select  
Sheets("Blatt3").Activate  
leereZeile = Sheets("Blatt3").Cells(Rows.Count, 1).End(xlUp).Row + 1  
For I = 2 To Sheets("Blatt3").Cells(Rows.Count, 1).End(xlUp).Row  
eintragCheck2 = Sheets("Blatt3").Cells(I, 1).Value  
If EintragCheck1 = eintragCheck2 Then
MsgBox "Eintrag schon vorhanden"  
Exit Sub
Else
End If
Next
Sheets("Blatt3").Range("B" & leereZeile).Select  
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'  
End Sub

Hoffentlich ist es jetzt verständlicher.
Danke.
Gruß
Hugo

Hallo,

Zitat von @hugoundertaker:
Hier nun der Hauptcode:

Bitte nutze die Code tags Formatierungen in den Beiträgen Das tut einem ja in den Augen weh...

Frage war, wie geht das mit dem Rücksprung zur Inputbox am Anfang des Codes bzw. warum kopiert er nicht wenn das Datum nicht vorhanden ist?

Schon mal deinen Code im Einzelschrittmodus durchgetickert und geschaut welche Werte wann und wo existieren und wie deine Entscheidungen darauf reagieren (nennt sich Debuggen)?

Gruß,
Peter

Hallo Peter,

ja natürlich habe ich es schon mit Einzelschritten probiert. Entweder kommt er dann zur Meldung "Datum schon vorhanden"(wenn schon vorhanden) springt aber nicht an den Anfang (Inputbox bzw. Start des Codes) zurück, da weiß ich aber auch leider nicht wie man das machen kann, oder wenn das Datum noch nicht vorhanden ist kopiert er aber nicht sondern läuft einfach zum Ende durch.
Danke.
Gruß
Hugo

Hallo,

Zitat von @hugoundertaker:
springt aber nicht an den Anfang (Inputbox bzw. Start des Codes) zurück

Sondern? Du siehst doch was dein Code als nächstes tun will. Ist aber auch im Einzelschrittverfahren ganz klar erkennbar was dort passiert und das vergleichst du mit deinen "Was will ich".

ich aber auch leider nicht wie man das machen kann,

Deinen Code sagen was der tun soll.

oder wenn das Datum noch nicht vorhanden ist kopiert er aber nicht sondern läuft einfach zum Ende durch.

Joa. Klar. Und wenn du noch deinen Code (auch nachträglich möglich) in Code Tags pappst, kann ich dir auch ein Zeilennummer nennen. Aber auch das siehst du wenn du deinen Code im Einzelschrittverfahren durchtickerst. Du solltest deine Code schon lesen und verstehen können und sehen was passiert obwohl du wolltest das etwas anderes passiert.

Gruß,
Peter

> ich aber auch leider nicht wie man das machen kann,
Deinen Code sagen was der tun soll.

Hallo Peter,

wenn ich wüßte, wie der Befehl für den entsprechenden Rücksprung lautet, würde ich nicht fragen. Ich bin nun mal kein Excel bzw. VBA-Spezialist. Vielleicht wäre es einfach auch mal möglich einem nicht Crack die Dinge vernünftig, so das er sie auch versteht, zu erklären.
Schließlich habe ich doch mein Problem relativ ausführlich erklärt. Und das mit den CodeTags funktioniert auch nicht, vielleicht mache ich da ja was falsch. Aber vielleicht kann man mir ja trotzdem einfach mal helfen???
Trotzdem Danke.
Gruß
Hugo

Hallo hugo,
lad dir dieses Demonstrations-File runter. In diesem sind zwei Excel-Files, Kopiere beide Files in einen Ordner und das mit den Makros öffnest du dann.
ExcelSearchAndCopy_233072.zip

Hier der Code daraus:

Dim wbTarget
Dim wbSource

Sub Suche()
    Set wbSource = Workbooks(1)
    If TypeName(wbTarget) = "Empty" Then  
        Set wbTarget = Workbooks.Open(ActiveWorkbook.Path & "\DOC2.xlsx")  
    End If
    Set wsIN1 = wbSource.Worksheets(1)
    Set wsIN3 = wbSource.Worksheets(3)
    Set wsOUT = wbTarget.Worksheets(3)
    
    found = False
    With wsOUT.Range("B:B")  
        Set c = .Find(wsIN1.Range("A3").Value, LookIn:=xlValues)  
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                found = True
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
    If Not found Then
        wsIN3.Range("A1:A5").Copy  
        wsOUT.Range("B1").End(xlDown).Offset(1, 0).PasteSpecial  
    Else
        MsgBox "Datum schon vorhanden"  
    End If
    
End Sub

Denke daran kannst du dir abschauen wie es funktioniert, und ich erspare mir ausschweifende Erläuterungen. Habe es nach deiner ursprünglichen Beschreibung aufgebaut. Deinen Code habe ich jetzt nicht beachtet, da ohne Codetags, dazu fügst den Code zwischen solche Tags ein:

Grüße Uwe

[OT]
Moin hugoundertaker, Pjordorf und colinardo,

Zitat von @colinardo:

Denke daran kannst du dir abschauen wie es funktioniert, und ich erspare mir ausschweifende Erläuterungen.

Davon glaube ich weder den ersten noch den zweiten Teilsatz.

Immerhin haben schon die diversen Hinweise, wie sich hier im Forum Kot in Täx packen lassen könnte, ungefähr 73 laufende Zentimeter dieses Beitrags in Anspruch genommen.

Ich denke auch, es wäre zielführender, auf die jeweilige Zeilennummer im (mit Codetags formatierten) Sourcefragment hinweisen zu können als ein Rundum-Sorglos-Paket zu liefern.

Aber in diesem Beitrag weigere ich mich auch, die Codetags nachzutragen - wie das geht, ist jetzt schon gefühlte 5x geppostet worden

Ist alles sehr knapp am Papierkorb vorbei.

Grüße
Biber
[/OT]

Hallo,

Zitat von @hugoundertaker:
nun mal kein Excel bzw. VBA-Spezialist.

Aber du hast es doch geschafft diesen Code zu Schreiben.

Und das mit den CodeTags funktioniert auch nicht, vielleicht mache ich da ja was falsch.

Aber was? Und ein "funktioniert nicht" ist eben keine Fehlermeldung oder etwas mit irgendeiner irgendetwas anfangen kann.

Hier steht ein Text der Quellcode darstellen soll

oder

Hier steht Text der kein Quellcode darstellen soll

. Den Unterschied mit der Zeilennummern siehst du?

Aber vielleicht kann man mir ja trotzdem einfach mal helfen???

Etwa so?

Du rufts deine Procedure Datumscheck ' Prüfen ob Datum schon vorhanden auf, diese wird abgearbeitet und dann kommst du zurück. Du machst dann dort weiter mit dein Arbeitsblattloeschen und da ist eben dein Fehler. Du musst bevor du dein Arbeitsblattloeschen aufrufst schauen ob dein Datumscheck ' Prüfen ob Datum schon vorhanden ein datum gefunden hat oder nicht und entsprechend dann entscheiden ob du normal weitermachen willst oder etwas anderws tun willst. Entweder merkst du dier mit Hilfe einer Globalen (Public) Variable ob deine datumsprüfung erfolgreich war oder etwas eleganter ist es, wenn du deine Procedure Datumscheck ' Prüfen ob Datum schon vorhanden in einer Funktion namens Datumscheck ' Prüfen ob Datum schon vorhanden wandelst und dir als Rückgabewert ein Wahr oder Falsch liefern lässt und dieses dann als Entscheidungskriterium ob einfach weiter oder eben etwas anderes genmacht werden soll.

Eine Funktion liefert einen Rückgabewert, eine Procedure nicht. Sub Funktion oder SUB.
Eine Variable kann lokal an eine Procedure oder Funktion gebunden sein oder halt Global über alle Module hinweg

Es gibt sicherlich noch mehr Varianten um den Ablauf des Programms dazu zu bringen deine Wünsche gerecht zu werden. Das sind nur zwei davon.

Gruß,
Peter

Hallo zusammen,

das mit den Code Tags war ein Denkfehler, ich dachte das er mir das auch entsprechend in der Vorschau anzeigt und da tat sich nichts. Jetzt aber die Zeit gehabt es nochmal zu probieren. Vielleicht kann ja jetzt noch mal bitte einer drüberschaun.

Danke.
Gruß
Hugo

Zitat von @hugoundertaker:
das mit den Code Tags war ein Denkfehler, ich dachte das er mir das auch entsprechend in der Vorschau anzeigt und da tat sich nichts.

das ist in der Tat gerade ein Bug des Systems, was ich heute schon @Frank gemeldet habe...