Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: Änna am Juli 25, 2019, 15:53:31 Nachmittag

Titel: Office 2013: VBA Integration einer Tabelle in eine andere
Beitrag von: Änna am Juli 25, 2019, 15:53:31 Nachmittag

Hallo ihr Lieben,

ich bin kompletter Neuling bei VBA und hoffe auf Hilfe, da ich im Internet nichts genau passendes gefunden habe und meine Kenntnisse zum umformulieren von Codes nicht ausreichen. Die Zeit, für diese eine Aufgabe VBA von Grund auf zu erlernen, habe ich leider nicht und hoffe deshalb auf eure Hilfe. Das Umformulieren von vorhandenen Codes hat nämlich gar nicht geklappt..:(

Folgendes Problem möchte ich lösen:

Ich habe eine Excel Datei, die auf einem Tab ein paar beschriebene Zeilen hat (abc.xlsx). Eine zweite (abc2.xlsx), die ähnlich aufgebaut ist. Beide haben die gleiche Spaltenanzahl, jedoch unterschiedliche viele beschriebene Zeilen. Nun möchte ich ein VBA Skript haben, welches mir die Inhalte der beiden Dateien in einem Tab in einer Datei zusammenführt, sodass die Zeilen von der zweiten Datei nach der letzten Zeile der ersten Datei eingefügt werden (abc_abc2.xlsx).
Das Ganze soll so dynamisch formuliert sein, dass es automatisch erkennt wie viele Dateien in der ersten wie auch in der zweiten Datei stehen.

Könnt ihr mir weiterhelfen? Vielen Dank schonmal!

Viele Grüße,
Anna
 

Titel: Antw:Office 2013: VBA Integration einer Tabelle in eine andere
Beitrag von: gmg-cc am Juli 25, 2019, 17:45:31 Nachmittag

Moin Anna,

dass du ein solches VBA-Programm haben möchtest kann ich nachvollziehen. Aber da ein Forum prinzipiell "Hilfe zur Selbsthilfe" als Motto hat frage ich dich, wie weit du selbst aktiv werden kannst. Full Service wird gewiss gerne von den Foren-Betreibern geleistet, siehe auch die Texte unten ...

Titel: Antw:Office 2013: VBA Integration einer Tabelle in eine andere
Beitrag von: Änna am August 13, 2019, 14:42:47 Nachmittag

Hi gmg-cc,

ich habe nun folgendes VBA Skript, welches (fast) alle Probleme löst:

Option Explicit

Sub Kopieren()
    Dim i               As Long
    Dim sPfad           As String
    Dim sDatei          As String
    Dim vFileToOpen     As Variant
    Dim lngLZ           As Long
    Dim blnÜberschrift  As Boolean
    Dim iCalc           As Integer
   
   
    vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
    If Not IsArray(vFileToOpen) Then Exit Sub
   
       
    iCalc = Application.Calculation

    On Error GoTo ENDE:
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
   
   
    For i = 1 To UBound(vFileToOpen)
        sDatei = Dir(vFileToOpen(i))
        sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
   
        With Tabelle1.Range("A1")
            .Formula = "=LOOKUP(2,1/('" & sPfad & "[" & sDatei & "]Tabelle1'!$A:$A<>""""),ROW('" & sPfad & "\[" & sDatei & "]Tabelle1'!$A:$A))"
            lngLZ = .Value
        End With
       
        With Tabelle1
            If blnÜberschrift Then
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ - 1, 10).Formula = _
                "='" & sPfad & "[" & sDatei & "]Tabelle1'!A2"
            Else
                blnÜberschrift = True
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ, 10).Formula = _
                "='" & sPfad & "[" & sDatei & "]Tabelle1'!A1"
            End If
        End With
       
        Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
    Next
   
    With Tabelle1.UsedRange
        .Copy
        .PasteSpecial xlPasteValues
        .Rows(1).Delete
    End With
   
ENDE:
    Application.EnableEvents = True
    Application.Calculation = iCalc
    Application.ScreenUpdating = True
    If Err Then MsgBox Err.Description, , "Fehler: " & Err
End Sub

Sub StatusBalken(ProzentSatz) ''ProzentSatz = Int((i / 10000) * 100)
    Dim Mess, Z, Rest
    Static oldStatusBar As Integer
    Static blnInit As Boolean

    If Not blnInit Then
        oldStatusBar = Application.DisplayStatusBar
        Application.DisplayStatusBar = True
    End If
   
    Mess = ""
    For Z = 1 To ProzentSatz
        Mess = Mess & ChrW(Val("&H25A0"))
    Next Z
    Rest = 100 - ProzentSatz
    For Z = 1 To Rest
        Mess = Mess & ChrW(Val("&H25A1"))
    Next Z
    Application.StatusBar = Mess & " " & ProzentSatz & "%"
   
    If Rest <= 0 Then
        Application.StatusBar = False
        Application.DisplayStatusBar = oldStatusBar
    End If
End Sub


_______________________________________________________________________________________________

Nun noch eine Frage:

Ich möchte nicht, dass immer das Tabellenblatt1 angesprochen wird, sondern das jeweilige Tabellenblatt mit dem Namen "Plants". Dafür habe ich statt Tabellenblatt1 Sheets("Plants") geschrieben, jedoch wird in der Zeile

.Formula = "=LOOKUP(2,1/('" & sPfad & "[" & sDatei & "]Tabelle1'!$A:$A<>""""),ROW('" & sPfad & "\[" & sDatei & "]Tabelle1'!$A:$A))"

eine Fehlermeldung angezeigt.


Ich hoffe, meine Fragen sind jetzt konkret genug, um Hilfe zu bekommen :)