Import zwischen Mappen mit Bedingungen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Import zwischen Mappen mit Bedingungen
von: Michael
Geschrieben am: 31.07.2015 10:53:50

Hallo Forum,
mit folgendem Code importiere ich mir zwischen zwei Mappen Daten:

Private Sub Import()
  Dim oTargetSheet      As Object
  Dim oSourceSheet      As Object
  Dim oSourceFile       As Object
  Dim z                 As Long
  Dim zMax              As Long
  Dim zInsert           As Long
  
    Application.ScreenUpdating = False
  
    Set oTargetSheet = ThisWorkbook.Sheets(1) 
    
    Set oSourceFile = Workbooks.Open(sIMPORTFILE, False, True) 
    Set oSourceSheet = oSourceFile.Sheets("Import") 
    
    zMax = oSourceSheet.UsedRange.Rows.Count + oSourceSheet.UsedRange.Row - 1
    
    zInsert = lFIRSTINSERTROW
    
    For z = lSTARTROW To zMax
    
        'Bedingungen abfragen
        If IsNumeric(oSourceSheet.Cells(z, lIFCOL1).Value) = True Then
            If CDbl(oSourceSheet.Cells(z, lIFCOL1).Value) > 0 And _
               (UCase(Trim(CStr(oSourceSheet.Cells(z, lIFCOL2)))) = "FALSE" Or _
                Trim(CStr(oSourceSheet.Cells(z, lIFCOL2))) = "") Then
                                
                oTargetSheet.Cells(zInsert, 1) = oSourceSheet.Cells(z, 4)
                oTargetSheet.Cells(zInsert, 3) = oSourceSheet.Cells(z, 6)
                oTargetSheet.Cells(zInsert, 4) = oSourceSheet.Cells(z, 7)
                oTargetSheet.Cells(zInsert, 6) = oSourceSheet.Cells(z, 17)
                oTargetSheet.Cells(zInsert, 7) = oSourceSheet.Cells(z, 15)
                oTargetSheet.Cells(zInsert, 8) = oSourceSheet.Cells(z, 31)
                'Einfügezeile erhöhen
                zInsert = zInsert + 1
            
            End If
        End If
        
    Next z
    
    oSourceFile.Close False
    
    Application.ScreenUpdating = True
    
    Set oTargetSheet = Nothing
    Set oSourceSheet = Nothing
    Set oSourceFile = Nothing
    
    MsgBox "Import done."
    
End Sub
soweit so gut. Jedoch hab ich folgendes Problem. Ich möchte wenn einmal Werte importiert und in der Zielmappe bearbeitet wurden nicht mehr überschreiben dürfen. Eine Art Append Geschichte wie man sie aus Access kennt wo man Primärschlüssel vergibt und Duplikate von bestimmten Kombinationen unterbindet.
In meinem Fall würde ich gerne in meiner Zielmappe einen Code voran stellen, der die Werte in der Quell- (Spalte D) und Zielmappe (Spalte A) miteinander vergleicht. Bei Übereinstimmung soll nicht importiert werden. Nur Werte die in der Zielmappe noch nicht enthalten sind.
Hat jemand so etwas mal gemacht und könnte mir hierzu ein paar Tipps geben?
Gruß
Michael

Bild

Betrifft: AW: Import zwischen Mappen mit Bedingungen
von: Michael
Geschrieben am: 01.08.2015 20:04:46
Hallo Michael,
prinzipiell, indem Du nach if..then vor der ersten Zuweisungszeile
oTargetSheet.Cells(zInsert, 1) = oSourceSheet.Cells(z, 4)
ein .find vornimmst.
Eine ähnliche Geschichte war erst vor ein paar Tagen...
https://www.herber.de/forum/archiv/1436to1440/t1439368.htm#1439368
... allerdings andersherum: wenn gefunden, dann kopieren.
.find mag bei sehr vielen Daten zu viel Zeit kosten.
Übrigens hast Du uns alle groß geschriebenen Variablen unterschlagen - sind die global definiert?
Um wieviele Daten geht es denn so?
Wenn es wirklich viele sind, würde ich etwa so vorgehen:
1. im oSourceSheet in eine Hilfsspalte eine Formel schreiben, die alle "If"s erledigt und, wenn's paßt, true oder false oder 1 oder 0 oder was auch immer schreibt.
2. danach sortieren
3. alles, was paßt, spaltenweise nach oTargetSheet kopieren (damit die richtigen Spalten gleich untereinander stehen), und zwar incl. Hilfsspalte (die kann man ja irgendwo positionieren, wo sie nicht stört)
4. ein eine weitere Hilfsspalte eine Formel schreiben, á la ...
usw. siehe Datei: https://www.herber.de/bbs/user/99239.xls
Hört sich umständlich an, läßt sicher aber relativ einfach in VBA realisieren und ist sicher schneller als das Zuweisen einzelner Werte.
Schöne Grüße,
Michael

Bild

Betrifft: AW: Import zwischen Mappen mit Bedingungen
von: Michael
Geschrieben am: 03.08.2015 11:58:48
Hallo Michael,
erstmal Danke für deine Antwort. Müsste ich mal ausprobieren. Ich hab auch irgendwo gelesen, dass das ganze auch als Schleife in Schleife gelöst werden kann. Sprich bevor man kopiert schaut man mittels Schleife im Einfügebereich, ob der einzufügende Eintrag schon vorhanden ist. Hier kann man dann eine IF Abfrage nutzen. Wenn ein Eintrag gefunden wird setzt man die Variable vom Typ Boolean auf True und vor der Schleife auf den Initialwert False. So könnte man vor dem Kopiervorgang prüfen ob der Eintrag gefunden wurde. Wenn nicht (false) wird kopiert.
Ich kämpfe noch mit der Umsetzung aber bisweilen will das noch nciht klappen. Hat vielleicht jemand einen Rat wie der Code aussehen müsste?
Gruß
Michael

Bild

Betrifft: Fragen? Beispielmappe?
von: Michael
Geschrieben am: 03.08.2015 14:53:43
Hallo Michael,
wenn Du möchstest, daß Dir geholfen wird, mußt Du schon die Fragen beantworten:
- um welche Datenmengen handelt es sich?
- was sind die groß geschriebenen Variablen? Im Code erfolgt keine Zuweisung.
Das Beste wäre, Du lädst eine anonymisierte Beispielmappe incl. dem vorhandenen Makro-Stand hoch, dann können wir Dir am besten helfen.
Schöne Grüße,
Michael

Bild

Betrifft: AW: Fragen? Beispielmappe?
von: Michael
Geschrieben am: 03.08.2015 15:39:39
Hallo Michael,
nachfolgend der ganze Code:

Option Explicit
Private Const sIMPORTFILE As String = "C:\Users\Michael\Desktop\Import.xls"
Private Const lSTARTROW As Long = 3
Private Const lFIRSTINSERTROW As Long = 50
Private Const lIFCOL1 As Long = 15 'O
Private Const lIFCOL2 As Long = 33 'AG
Private Sub Data_Import()
  Dim oTargetSheet      As Object
  Dim oSourceSheet      As Object
  Dim oSourceFile       As Object
  Dim z                 As Long
  Dim zMax              As Long
  Dim zInsert           As Long
  
    Application.ScreenUpdating = False
  
    Set oTargetSheet = ThisWorkbook.Sheets(1)
    
    Set oSourceFile = Workbooks.Open(sIMPORTFILE, False, True)
    Set oSourceSheet = oSourceFile.Sheets("Data")
    
    zMax = oSourceSheet.UsedRange.Rows.Count + oSourceSheet.UsedRange.Row - 1
    
    zInsert = lFIRSTINSERTROW
    
    For z = lSTARTROW To zMax
    
        If IsNumeric(oSourceSheet.Cells(z, lIFCOL1).Value) = True Then
            If CDbl(oSourceSheet.Cells(z, lIFCOL1).Value) > 0 And _
               (UCase(Trim(CStr(oSourceSheet.Cells(z, lIFCOL2)))) = "FALSE" Or _
                Trim(CStr(oSourceSheet.Cells(z, lIFCOL2))) = "") Then
                                
                oTargetSheet.Cells(zInsert, 1) = oSourceSheet.Cells(z, 4)
                oTargetSheet.Cells(zInsert, 3) = oSourceSheet.Cells(z, 6)
                oTargetSheet.Cells(zInsert, 4) = oSourceSheet.Cells(z, 7)
                oTargetSheet.Cells(zInsert, 6) = oSourceSheet.Cells(z, 17)
                oTargetSheet.Cells(zInsert, 7) = oSourceSheet.Cells(z, 15)
                oTargetSheet.Cells(zInsert, 8) = oSourceSheet.Cells(z, 31)
                'Einfügezeile erhöhen
                zInsert = zInsert + 1
            
            End If
        End If
        
    Next z
    
    oSourceFile.Close False
    
    Application.ScreenUpdating = True
    
    Set oTargetSheet = Nothing
    Set oSourceSheet = Nothing
    Set oSourceFile = Nothing
    
    MsgBox "Import done."
    
End Sub
Die Datenmenge beschränkt sich auf ca. 50 Zeilen. Auf täglicher Basis ziehe ich mir ein Excel Sheet aus dem Internet. Aus der anderen Arbeitsmappe führe ich das Makro aus um mir die relevanten Daten zu importieren. Bereits einmal importierte Daten sollen nicht mehr überschrieben werden. In der Zieldatei soll die Spalte A mit der Spalte D in der Quelldatei verglichen werden. Handelt es sich um den selben Wert, in meinem Fall ein Name, dann soll diese Zeile nicht kopiert werden. Alle anderen Zeilen wo die Bedingungen größer 0 und False zutreffen sollen kopiert werden.
Ich hatte schon etwas mit .find experimentiert aber komme nicht besonders weit:
Sub suchen()
Dim begriff$
Dim i&, bis&, bis2&
Dim c As Range
bis = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
bis2 = oSourceFile.Sheets("Data").Range("D" & Rows.Count).End(xlUp).Row
' Sheets("Data").Activate
For i = 3 To bis
  begriff = oSourceFile.Sheets("Data").Range("D" & i).Value
  Set c = ThisWorkbook.Sheets(1).Range("A50:A64" & bis2).Find(What:=begriff, _
        LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
  If Not c Is Nothing Then
      Sheets(1).Range("A" & i).Value = c.Value
     c.Offset(0, -1).Value = "x"
    Else
     Sheets("Namen").Range("B" & i).Value = "[nicht gefunden]"
  End If
Next
End Sub
Besonders nach If Not c Is Nothing Then weiß ich nicht ganz genau was ich eintragen soll?
Gruß
Michael
P.S.: Das mit einer Beispielmappe ist etwas kompliziert weil viele persönliche Angaben. Eine anonymisierte Datei würde etwas Zeit in Anspruch nehmen die ich dann gerne erstelle wenn das hier nicht ausreicht.

Bild

Betrifft: Genau das ist der Punkt,
von: Michael
Geschrieben am: 03.08.2015 17:10:06
Michael,
denn auch ich habe anderes zu tun, als irgendwelche Daten zusammenzubasteln, nur um Dir zu helfen.
Mit einer kompletten Datei sind das halt ein paar Handgriffe, aber ohne kann ich ins Blaue programmieren, ohne eine Möglichkeit, schnell zu testen, ob es paßt.
Gruß,
Michael

Bild

Betrifft: AW: Genau das ist der Punkt,
von: Michael
Geschrieben am: 04.08.2015 10:06:36
Verständlich Michael,
ich hab mal die beiden Dateien angehängt. Aus dem Quellsheet sollen relevante Daten in das Zielsheet kopiert werden (Makro enthalten "Import"). Dabei sollen nur die Werte kopiert werden, die nicht bereits in der Zieldatei enthalten sind. Ich hab noch keine Ahnung wie ich das handhaben soll, dass erst geprüft wird ob die Werte in den beiden Sheets gleich sind, danach eventuell kopiert und das unterhalb der bereits vorhandenen Einträge in der Zieldatei.
Vielleicht hast Du oder jemand anders noch einen Rat dazu?
https://www.herber.de/bbs/user/99311.xls
https://www.herber.de/bbs/user/99312.xlsm
Gruß
Michael

Bild

Betrifft: So könnte es tun
von: Michael
Geschrieben am: 06.08.2015 12:39:15
Hi Michael,
ich habe Deine Datei leicht überarbeitet und die gewünschte Suche eingebaut.
Hier: https://www.herber.de/bbs/user/99364.xlsm
Sieh Dir bitte die Kommentare im Code an.
Happy Exceling,
Michael

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Import zwischen Mappen mit Bedingungen"