Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon sockly vom 31.03.2020, 15:29 Options

Messergebnisse zusammenfassen

Hi Leute,

ich habe eine unbekannte Anzahl von Messergebnissen in Excel Dateien im xls Format. Die Dateien sind allesamt in einem Ordner zB C:\Messergebnisse gespeichert.
In den Dateien erstrecken sich die Ergebnisse von Zelle B8 bis Zelle G32 !
Ich will nun eine Haupt-Messergebnisdatei erstellen !
Diese soll auf Buttonklick sämtliche Ergebnisse aus den Dateien im Ordner C:\Messergebnisse in sich zusammenfassen !

Ich stell mir das Quasi so vor:
- Datei zusammenfassung.xls wird geöffnet
- Buttonklick
=> Makro wird ausgeführt:
- öffnet Datei #1, kopiert Messwerte aus B8:G32 in zusammenfassung.xls nach B6 !
- schließt Datei #1, öffnet Datei #2, kopiert Messwerte aus B8:G32 in zusammenfassung.xls nach B33 (zwecks Übersicht sollen 2 Reihen freigelassen werden)
- schließt Datei#2, öffnet Datei#3, ...

usw.

Ich habe was VBA angeht zwei linke Hände... ein klitzekleines Grundwissen besitze ich, aber für solch tw. komplexe angelegenheiten reicht es leider nicht !

Ich hoffe, ihr könnt mir helfen !

MfG und Dankeschön,
sockly

Antwort schreiben

Antwort 1 von Beverly vom 31.03.2020, 19:19 Options

Hi,

vielleicht eine Möglichkeit

Sub daten_uebernehmen()
    Dim strFile As String
    Dim strPath As String
    Dim loZeileZielmappe As Long
    Dim inSpalte As Integer
    Dim loZeileQuellmappe As Long
    Dim loZaehler As Long
    Application.ScreenUpdating = False
    strPath = "C:\Test\"
    strFile = Dir(strPath & "*.xls")
    loZeileZielmappe = 6
    loZaehler = 6
    Do While strFile <> ""
        If strFile <> ThisWorkbook.Name Then
            For inSpalte = 2 To 7
                loZeileZielmappe = loZaehler
                For loZeileQuellmappe = 8 To 32
                    Cells(loZeileZielmappe, inSpalte).Formula = "='" & strPath & "[" & strFile & "]" & "Tabelle1" & "'!" & Chr(inSpalte + 64) & loZeileQuellmappe
                    loZeileZielmappe = loZeileZielmappe + 1
                Next loZeileQuellmappe
            Next inSpalte
        End If
        loZaehler = loZaehler + 25
        loZeileZielmappe = loZaehler
        strFile = Dir()
    Loop
    Range("B6:G" & loZeileZielmappe).Copy
    Range("B6:G" & loZeileZielmappe).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Wenn es viele Arbeitsmappen sind, kann es schon einige Zeit dauern, bis alle Daten übernommen worden sind.

Bis später,
Karin

Antwort 2 von sockly vom 01.04.2020, 09:12 Options

Hi Karin,

danke für dein Makro !
Es funktioniert schon ganz gut, aber ich habe noch 2 Fragen:
1) Dein Makro holt sich ja jeden Wert einzeln aus den Excel Files. Ist das nicht ein bisschen zu aufwendig ? Man kann sich doch auch direkt die 150 Werte aus B8:G32 holen oder ?
2) Sortiert dein Makro die Dateien vorher nach dem Dateinamen ? Ich konnte nämlich jetzt nicht so ganz durchblicken, mit welcher Datei er angefangen hat !

MfG und Dankeee für deine Hilfe,
sockly

Antwort 3 von sockly vom 01.04.2020, 09:17 Options

ahhh noch eine Frage vergessen :D:D

3) Der holt sich jetzt nur die Werte aus 2 Excel Files... Ich will aber auf n Excel Files zugreifen können (je nach dem wie viele in dem Ordner sind...). Wie passe ich dementsprechend das Makro an ?

MfG,
sockly

Antwort 4 von sockly vom 01.04.2020, 09:23 Options

Frage 3 wird zurückgezogen :-D

Antwort 5 von sockly vom 01.04.2020, 12:37 Options

okay...
hab meine probleme selbst gelöst bekommen...

danke für die Hilfe Karin !
dein Code ist spitze !

Antwort 6 von Beverly vom 01.04.2020, 16:09 Options

Hi,

leider kann ich erst jetzt antworten. Wo lag denn das Problem?

Übrigens kann man sich auch noch den Dateinamen z.B. in Spalte A eintragen lassen. Ergänze den Code

        If strFile <> ThisWorkbook.Name Then
            [b]Cells(loZeileZielmappe, 1) = strFile[/b]
            For inSpalte = 2 To 7
                loZeileZielmappe = loZaehler
                For loZeileQuellmappe = 8 To 32
                    Cells(loZeileZielmappe, inSpalte).Formula = "='" & strPath & "[" & _
                        strFile & "]" & "Tabelle1" & "'!" & Chr(inSpalte + 64) & loZeileQuellmappe
                    loZeileZielmappe = loZeileZielmappe + 1
                Next loZeileQuellmappe
            Next inSpalte
        End If

Bis später,
Karin

Antwort 7 von sockly vom 02.04.2020, 09:35 Options

    
Dim mySHFolderItem As Object, myObjShell As Object
    Dim myDefaultPath As Variant
    Dim myObjFolder As Object
    myDefaultPath = "" 
    Set myObjShell = CreateObject("Shell.Application")
    Set myObjFolder = myObjShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, myDefaultPath)
    If myObjFolder Is Nothing Then Exit Sub
    Set mySHFolderItem = myObjFolder.Self
    strPath = mySHFolderItem.Path & ("\")
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls")

ich habs so mit ordnerabfrage gelöst...
ging auch 1A !

dazu hab ich ne frage... wie vermittle ich dem Makro denn, dass es auch die Unterordner durchsuchen soll ?

MfG,
sockly

Antwort 8 von sockly vom 04.04.2020, 09:10 Options

hi,

sorry, dass ich den thread nochmal hochhole, aber ich stehe noch vor einem Problem:

Wie vermittle ich dem Makro denn, dass es auch die Unterordner durchsuchen soll ?

Mit freundlichem Gruß,
sockly

Antwort 9 von Beverly vom 04.04.2020, 11:34 Options

Hi,

dann musst du Application.FileSearch verwenden anstelle von Dir.

Bis später,
Karin

Antwort 10 von huepfer vom 04.04.2020, 12:01 Options

hmpf...
Dabei hatte das eigentlich so gut geklappt !
naja, ich werde mich mal daran versuchen !

Wenn ich es net hinbekomme, melde ich mich hier nochmals !

Dnake für deine Hilfe, Karin !

Gruß,
huepfer

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..