Microsoft Excel

Herbers Excel/VBA-Archiv

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

Hilfe.. ich verzweifel :(

Betrifft: Hilfe.. ich verzweifel :( von: Crini
Geschrieben am: 27.08.2014 18:25:49

Guten Tag,

ich bin ein kompletter VBA-Neuling, benötige aber ein Makro, welches mir Inhalte aus mehreren Dateien (entweder aus einer Excel oder einer Word-Datei) kopiert und in eine "Übersichtsdatei" nacheinander zusammenfügt.
Es gibt also ca. 26 komplett gleich aufgebaute Excel-Dateien (beinhaltet ca. 50 Zeilen und 5 Spalten, wobei die Werte nur aus den Spalten 3-5 importiert werden sollen und die Zeilenanzahl variieren kann).
Die von unterschiedlichen Personen ausgefüllte Datei (Spalte A + B bleiben gleich, es wird nur Spalte C, D und E ausgefüllt) wird mir per Mail zugeschickt und ich speichere diese in einem bestimmten Ordner ab.

Ich möchte nun eine Datei erstellen, die mir auf Knopfdruck die Inhalte der 1. Zeile Spalte C, D und E aller Personen in die Spalte C, D und E untereinander schreibt. Anschließend sollen alle Inhalte der 2. Zeile aufgeführt werden usw.

Ich habe im Internet bereits folgendes Makro gefunden, welches meinem Ziel sehr nahe kommt:

Sub Import_Aufgabenbereich()
    Dim objDocument As Object
    Dim strDatei As String
    Dim strPfad As String
    Dim objApp As Object
    On Error GoTo Fin
    ' Pfad anpassen
    strPfad = "H:\Ordner\"
    Set objApp = OffApp("Word")
    ' Word nicht sichtbar
    'Set objApp = OffApp("Word", False)
    If Not objApp Is Nothing Then
        Columns(10).Clear
        strDatei = Dir$(strPfad & "*.doc*", vbDirectory)
        Do While strDatei <> ""
            Set objDocument = objApp.Documents.Open _
                (strPfad & strDatei)
            Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(2, 3).Range, _
                Chr(13) & Chr(7), "")
            Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(2, 4).Range, _
                Chr(13) & Chr(7), "")
            Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
                Replace(objDocument.Tables(1).Cell(2, 5).Range, _
                Chr(13) & Chr(7), "")
                
            objDocument.Close False
            
            strDatei = Dir$()
            
        Loop

    Else
        MsgBox "Applikation nicht installiert!"
    End If
Fin:
    If Not objApp Is Nothing Then
        If blnTMP = True Then
            objApp.Quit
            blnTMP = False
        End If
    End If
    Set objApp = Nothing
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub

Problem ist, dass ich nicht nur die eine Zelle der Spalte C (2,3), D (2,4), E (2,5) aus den jeweiligen Dateien benötige, sondern alle.. Das wird doch irgendwie mit einer Schleife (?) gehen oder?

Habe im Moment eine Lösung, indem ich das Makro 30 mal wiederhole und beim 2. Makro Spalte c (3,3), D (3,4), E (3,5), beim 3. Makro Spalte c (4,3), D (4,4), E (4,5), anwähle usw. und dann ein Start-Makro, welches alle 30 Makros hintereinander abspielt, dies ist jedoch sehr umständlich.

Zusätzlich habe ich das Problem, dass mir in der Übersichtsdatei leere Zeilen nicht eingefügt werden. Das bedeutet, dass wenn z.B. bei einer eingehenden Datei Zelle E1 leer ist (was häufig vorkommt), die Inhalte der nächsten Datei aus E1 in die Übersichtstabelle in die jeweilige Zeile der Spalte E eingefügt wird, anstatt die Zelle auch leer zu lassen. So passt die 3. Spalte nicht mehr zur 1., wenn ihr versteht, was ich meine? Es ist schwierig das zu formulieren ohne Kenntnisse.. :-( Vielleicht kann mir jemand helfen?

Vielen lieben Dank im Voraus!!

ich habe hier zwei Beispieldateien, wie sie bei mir eintreffen:

https://www.herber.de/bbs/user/92331.doc
https://www.herber.de/bbs/user/92332.doc

wenn man diese in einem Ordner abspeichert und den Pfad im Makro abändert, so kann man hoffentlich sehen, wo mein Problem liegt..

  

Betrifft: ... ich auch, aber.... von: MCO
Geschrieben am: 28.08.2014 07:36:11

Guten Morgen!

Dein Problem scheint mir gar nich so schwierig, die Schleifen hab ich reingebaut.
Allerdings kann ich sie nicht testen, weil eine "OLE-Anweisung nicht ausgeführt werden kann"... :-(

Wenn's bei dir läuft, ist´s OK.

Bau statt der einzelnen Zugriffe auf die Tabellenfelder folgendes ein:

doc_zeilen = objDocument.Tables(1).Rows.Count
For Z = 2 To doc_zeilen
    For sp = 3 To 5
        Cells(Rows.Count, sp).End(xlUp).Offset(1, 0).Value = _
               Replace(objDocument.Tables(1).Cell(Z, sp).Range, _
                        Chr(13) & Chr(7), "")
     Next sp
 Next Z

Der Code geht alle einzelnen vorhandenen Zeilen durch, darin jede Spalte.
Wie gesagt, ungetestet....

Gruß, MCO