Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Excel 2007 - Werte aus mehreren Dateien per Makro auslesen und in Übersichtstabelle einfügen

Frage Microsoft Microsoft Office

Mitglied: karatikus

karatikus (Level 1) - Jetzt verbinden

22.03.2013 um 14:10 Uhr, 5993 Aufrufe, 7 Kommentare

Hallo liebe Gemeinde, bitte um Mithilfe um grundlegende Daten aus mehreren Dateien in eine Übersicht zusammenzufassen...

Folgende Situation:

Im Zuge von Rechnungsprüfungen erhält jede Firma eine Prüfberichtsdatei. Diese liegen gesammelt in einem Ordner.
In einer neuen Datei (Kostenübersicht) sollten nun Informationen aus den Prüfberichtdateien zu einer Kostennummer zugeordnet werden.

Die Prüfberichtsdateien sind immer gleich aufgebaut. Alle relevanten Daten die zu übertragen sind, befinden sich in Tabelle 1.
In der Zeile H7 ist immer die zugeordnete Kostennummer eingetragen.
Nun sollen zusätzliche Information (Auftragsvolumen in H29, abgerechnete Kosten in H33 etc.) in die Kostenübersichtsdatei übertragen werden.

Die Kostenübersicht ist wie folgt aufgebaut.
Spalte A, pro Zeile immer eine Kostennummer, als Bsp. 0 - 1000.
Spalte B, C, sollte dann Informationen über Auftragsvolumen, abgerechnete Kosten beinhalten.

Das Makro sollte also, aufgrund der Kostennummer, als Beispiel, "500", alle Prüfberichte in einem separaten Ordner nach der Firma mit der Kostennummer "500" durchsuchen und die Werte von H29, H33 etc. in die richtige Zeile der Kostenverfolgungsdatei übertragen - sprich

A500 (Kostennummer 500) - B500 (Auftragsvolumen aus H29) - C500 (abgerechnete Kosten aus H33)

Ich hoffe das war mal so weit verständlich.

Was vlt. noch zusätzlich das Ganze verheikeln könnte, es kann vorkommen das 2 Firmen zu einer Kostennummer arbeiten - Ergot sollte in der Kostenverfolgungsdatei, dann z.B. unter 500 die Daten von Firma A & B addiert werden.

Falls die Dateinamen der Prüfberichte noch eine Relevanz spielen, diese sind immer gleich aufgebaut, da mittels Makro bezeichnet & abgespeichert:

Projektnummer_Prüfbericht_Kostennummer_KostennummeralsZahl_Kostennummerbeschreibung_Firmenname.xlsm
als Beispiel
105_Prüfbericht_Kostennummer_500_Sonstiges_Microsoft.xlsm

Ich bitte um eure Mithilfe, bin in VBA nicht wirklich bewandert. (Das automatische bezeichnen einer Datei und dem Speichern hab ich mir auch über Google holen müssen...)
Mitglied: karatikus
22.03.2013 um 14:20 Uhr
Nachtrag - der Lösungsanschlag unter folgender Frage geht schon in die richtige Richtung:

http://www.administrator.de/forum/wie-einzelne-zellen-aus-mehreren-exce ...

Es wäre nur noch notwendig dass die Daten automatisch zu der Zeile der richtigen Kostenummer eingefügt werden UND, falls der Fall Eintritt, das 2 oder mehrere Firmen auf einer Kostennummer arbeiten, das diese Summen dann addiert werden.

Würde dies eigentlich auch mit SVERWEIS gehen? Das Suchkriterium bildet ja immer die Kostennummer..
Bitte warten ..
Mitglied: karatikus
25.03.2013 um 11:02 Uhr
Mit folgendem Code kann ich zu mindest mal alle notwendigen Daten in meine Überischt übernehmen, allerdings schreibt er mir die Daten nur untereinander hinein (ist klar, weil ja nicht anders definiert ... )

Code:

Option Explicit
Option Compare Text

Const Folder = "C:\Prüfberichte\" 'Ist nur fiktiv, richtiger Ordner wird von mir eingesetzt

Const StartZeile = 7

Sub GetBKPData()
Dim Wkb As Workbook, Fso As Object, File As Object, Zeile As Long

Set Fso = CreateObject("Scripting.FileSystemObject") 'Dateisystem-Operationen

Range(Cells(StartZeile, "A"), Cells(Rows.Count, "E")).ClearContents 'Inhalte ab Startzeile löschen

Zeile = StartZeile

With Application
.ScreenUpdating = False 'Bildschirmaktualisierung aus
.AskToUpdateLinks = False 'Verknüpfung (Name aus Übersicht) ohne Abfrage aktualisieren
.DisplayAlerts = False 'Fehlermeldung "Verknüpfung kann nicht..." unterdrücken
End With

For Each File In Fso.GetFolder(Folder).Files
If Fso.GetExtensionName(File.Name) Like "xlsm" And Fso.GetBaseName(File.Name) Like "*2011-30*" Then
Set Wkb = GetObject(File.Path) '2011-30 kommt in der *.xlsm immer vor, da Projektnummer
With Wkb.Sheets(1) 'Werte mit Zahlenformat
.Range("H7").Copy: Cells(Zeile, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("D7").Copy: Cells(Zeile, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("D8").Copy: Cells(Zeile, "C").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H29").Copy: Cells(Zeile, "D").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H33").Copy: Cells(Zeile, "E").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("F46").Copy: Cells(Zeile, "F").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H41").Copy: Cells(Zeile, "G").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H42").Copy: Cells(Zeile, "H").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H4").Copy: Cells(Zeile, "J").PasteSpecial Paste:=xlPasteValuesAndNumberFormats


End With
Wkb.Close False: Zeile = Zeile + 1
End If
Next

Range(Cells(StartZeile, "A"), Cells(Zeile, "E")).Sort _
Key1:=Cells(StartZeile, "B"), Key2:=Cells(StartZeile, "A"), Header:=xlNo, Orientation:=xlTopToBottom

With Application
.DisplayAlerts = True
.AskToUpdateLinks = True
.ScreenUpdating = True
End With

ThisWorkbook.Save: MsgBox "Fertig", vbInformation, "Alle Daten eingelesen"
End Sub


Zielsetzung wäre es nun die Datensätze der richtigen BKP (Quelldatei H7), in der Übersichtsdatei der richtigen Zelle zuzuordnen. Kann bitte jemand meines (kopierten & modifierten) Codes annehmen?
Bitte warten ..
Mitglied: 76109
27.03.2013, aktualisiert um 10:52 Uhr
Hallo karatikus!

Nun sollen zusätzliche Information (Auftragsvolumen in H29, abgerechnete Kosten in H33 etc.) in die Kostenübersichtsdatei übertragen werden.
Spalte B, C, sollte dann Informationen über Auftragsvolumen, abgerechnete Kosten beinhalten.
Dies ist unstimmig, weil die Zellen H29/H33 in Deinem Code in Zelle Spalte D/E landen.

Um die Kostennummern in die richtigen Zeilen zu bringen, ist es sinnvoller, die Kostennummern als Zeilennummer zu verwenden bzw. Zeile = Kostennummer + Startzeile (Kostennummer ab 0).

Deine Anmerkung, dass die Kostennummer in die entsprechende Zeile soll, ist nicht ganz nachvollziehbar, da es zum ersten keine Zeile 0 (Kostennummer=0) gibt und zum anderen die Startzeile bei 7 beginnt?

In meinem Code werden die Kostennummern ab der Startzeile eingefügt, von daher ist es unerheblich, ob die Kostennummern nun bei 0 oder 1 beginnt. D.h. die Kostennummer 0 Landet in Zeile 7, die 1 in Zeile 8, die 500 Zeile 507...

Die Leerzeilen werden am Ende durch ein Sort nach Kostennummer eliminiert...
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
 Const iStartZeile = 7 
05.
 Const sFolder = "C:\Prüfberichte" 
06.
 
07.
Sub GetBKPData() 
08.
    Dim Wkb As Workbook, oFso As Object, oFile As Object 
09.
    Dim aQCells As Variant, iEndZeile As Long, iZeile As Long, i As Integer 
10.
 
11.
    Set oFso = CreateObject("Scripting.FileSystemObject") 'Dateisystem-Operationen 
12.
 
13.
    With Application 
14.
        .ScreenUpdating = False 'Bildschirmaktualisierung aus 
15.
        .AskToUpdateLinks = False 'Verknüpfung (Name aus Übersicht) ohne Abfrage aktualisieren 
16.
        .DisplayAlerts = False 'Fehlermeldung "Verknüpfung kann nicht..." unterdrücken 
17.
    End With 
18.
 
19.
    'Zell-Adressen in Array splitten 
20.
    aQCells = Split("H7,D7,D8,H29,H33,F46,H41,H42,H4", ",")  'Enspricht Spalte A, B, C, D, E, F, G, H, I 
21.
     
22.
     'Letzte Zeile in Spalte A ermitteln 
23.
    iEndZeile = Cells(Rows.Count, "A").End(xlUp).Row 
24.
     
25.
    'Zellinhalte ab Startzeile bis Copy-Spaltenanzahl (aQCells) löschen 
26.
    Range(Cells(iStartZeile, "A"), Cells(iEndZeile, UBound(aQCells) + 1)).Cells.Clear 
27.
     
28.
    For Each oFile In oFso.GetFolder(sFolder).Files 
29.
        If oFso.GetExtensionName(oFile.Name) Like "xlsm" And oFso.GetBaseName(oFile.Name) Like "*2011-30*" Then 
30.
            Set Wkb = GetObject(oFile.Path) '2011-30 kommt in der *.xlsm immer vor, da Projektnummer 
31.
            With Wkb.Sheets(1) 'Werte mit Zahlenformat 
32.
                iZeile = .Range("H7").Value + iStartZeile   'Zeile = Kostennummer + Startzeile 
33.
         
34.
                If IsEmpty(Cells(iZeile, "A")) Then 'Test Kostennummer noch nicht erfasst 
35.
                    'Zellen kopieren und einfügen 
36.
                    For i = 0 To UBound(aQCells) 
37.
                       .Range(Trim(aQCells(i))).Copy 
38.
                        Cells(iZeile, "A").Offset(0, i).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
39.
                    Next 
40.
                Else 
41.
                    'Spalte D/E aufaddieren 
42.
                    Cells(iZeile, "D").Value = Cells(iZeile, "D").Value + .Range("H29").Value 
43.
                    Cells(iZeile, "E").Value = Cells(iZeile, "E").Value + .Range("H33").Value 
44.
                End If 
45.
            End With 
46.
            Wkb.Close False 
47.
        End If 
48.
    Next 
49.
 
50.
    'Letzte Zeile in Spalte A ermitteln 
51.
    iEndZeile = Cells(Rows.Count, "A").End(xlUp).Row 
52.
     
53.
    'Zellinhalte ab Startzeile bis Copy-Spaltenanzahl (aQCells) sortieren 
54.
    Range(Cells(iStartZeile, "A"), Cells(iEndZeile, UBound(aQCells) + 1)).Sort _ 
55.
    Key1:=Cells(iStartZeile, "A"), Header:=xlNo, Orientation:=xlTopToBottom 
56.
 
57.
    With Application 
58.
        .DisplayAlerts = True 
59.
        .AskToUpdateLinks = True 
60.
        .ScreenUpdating = True 
61.
    End With 
62.
 
63.
    ThisWorkbook.Save: MsgBox "Fertig", vbInformation, "Alle Daten eingelesen" 
64.
 End Sub
Gruß Dieter
Bitte warten ..
Mitglied: karatikus
29.03.2013 um 07:52 Uhr
Danke Dieter das du dir die Sache angesehen hast und auch großen Dank für den einfacheren Quellcode als wie mein zusammengestoppeltes Werk.

Meine Kostennummern beginnen in der Übersicht erst ab Zeile 7, da darüber noch Bezeichnungen & allgemeine Projektinformationen drinnen stehen. Die Methode das die Zeilennummer = der Kostennummer ist, funktioniert leider nicht, da (was ich leider verschwiegen habe), die Kostennummern ähnlich von Leistungsgruppen aufgebaut sind.

z.B.:
"0." ist eine Hauptgruppe und steht in A10
"00." ist eine Leistungsuntergruppe und steht in A11
"001." ist die erste wirkliche Kostennummer und steht in A12
das geht dann bis "009." dann endet quasi diese Leistunggruppe und es beginnt eine Neue Leistungsgruppe ...

Die Nummern von Hauptgruppen & Leistungsuntergruppen kommen nie in einem Prüfbericht vor, da diese nur die Summen aus den Kostennummern addieren. Eine Kostennummer ist daher immer mindestens 3-stellig + "." . z.B: "215." "215.1" 215." etc...

Ich probier mich nochmals besser auszudrücken:
Die VBA Funktion sollte vordefinierte Werte aus den Prüfberichten ("H7,D7,D8,H29,H33,F46,H41,H42,H4") auslesen.
Diese Werte sollten in der Kostenübersicht dann der jeweiligen Zeile in Spalte A, wo die lt. Prüfbericht definierte Kostennummer gesucht und gefunden wird, in den nebenstehenden Spalten B,C,D,E.. eingefügt werden. In A darf nichts eingefügt werden, da dort alle Kostennummern drinnen stehen die ja das Sortierkriterium darstellen.

War wiederum ein Fehler von mir zu sagen das die Werte aus "H7" kopiert werden sollten, da dies im Prüfbericht ja die Kostennummer ist. H7 ist das Such- & Sortierkriterium wenn mans so ausdrücken kann.

Ich glaub ich drück mich nur zu kompliziert aus.. *g*

Vlt. ist ein Überarbeitung vom Code nochmals drinnen, danke im Vorraus
Bitte warten ..
Mitglied: 76109
29.03.2013, aktualisiert um 14:13 Uhr
Hallo karatikus!

Danke Dieter das du dir die Sache angesehen hast und auch großen Dank für den einfacheren Quellcode als wie mein zusammengestoppeltes Werk.
War ja für den Anfang gar nicht so schlecht

Die Nummern von Hauptgruppen & Leistungsuntergruppen kommen nie in einem Prüfbericht vor, da diese nur die Summen aus den Kostennummern addieren. Eine Kostennummer ist daher immer mindestens 3-stellig + "." . z.B.: "215." "215.1" 215." etc...
Wobei mir nicht ganz klar ist, ob die '215." und "215.1" unterschiedliche Kostennummern darstellen?

Und sind vorm Punkt immer 3 Zeichen oder können das auch mehr sein?


Gruß Dieter
Bitte warten ..
Mitglied: karatikus
02.04.2013 um 07:05 Uhr
Morgen,

215. und 215.1 stellen unterschiedliche Kostennummern dar.
Hauptgruppen X.
Leistungsgruppe XX.
Kostennummern von XXX. bis XXX.XX

Vor dem Punkt können maximal 3 Stellen stehen, danach maximal 2, somit besteht eine Kostennummer inkl "." aus maximal 6 Zeichen.

Lg,
Bitte warten ..
Mitglied: 76109
05.04.2013, aktualisiert um 16:11 Uhr
Hallo karatikus!

Dann versuchs mal hiermit:
01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const sFolder = "C:\Prüfberichte"              'Datei-Pfad Berichte 
05.
Const sFileName = "*2011-30*"                   'Datei-Name enthält 
06.
Const sFileType = "xlsm"                       'Datei-Erweiterung 
07.
 
08.
Const iStartZeile = 7       'Ab Zeile ? 
09.
Const sFilter = "=???.*"    'Kostennummer = 3 Zeichen + Punkt und keine/weitere Zeichen 
10.
 
11.
Const Msg1 = "Alle Daten eingelesen!" 
12.
Const Err1 = "Kostennummer (%1) in der Übersicht nicht gefunden!" 
13.
 
14.
Sub GetBKPData() 
15.
    Dim Wkb As Workbook, oFso As Object, oFile As Object, oFound As Range 
16.
    Dim aQCells As Variant, iEndZeile As Long, iZeile As Long, i As Integer 
17.
 
18.
    Set oFso = CreateObject("Scripting.FileSystemObject") 'Dateisystem-Operationen 
19.
 
20.
    With Application 
21.
        .ScreenUpdating = False    'Bildschirmaktualisierung aus 
22.
        .AskToUpdateLinks = False  'Verknüpfung (Name aus Übersicht) ohne Abfrage aktualisieren 
23.
        .DisplayAlerts = False     'Fehlermeldung "Verknüpfung kann nicht..." unterdrücken 
24.
    End With 
25.
 
26.
   'Copy-Zell-Adressen in Array splitten 
27.
    aQCells = Split("D7,D8,H29,H33,F46,H41,H42,H4", ",")  'Entspricht Spalte B, C, D, E, F, G, H, I 
28.
     
29.
    Call CleanUp(UBound(aQCells)) 
30.
     
31.
    For Each oFile In oFso.GetFolder(sFolder).Files 
32.
        If oFso.GetExtensionName(oFile.Name) Like sFileType And oFso.GetBaseName(oFile.Name) Like sFileName Then 
33.
            Set Wkb = GetObject(oFile.Path) '2011-30 kommt in der *.xlsm immer vor, da Projektnummer 
34.
            With Wkb.Sheets(1) 'Werte mit Zahlenformat 
35.
                Set oFound = Range("A:A").Find(.Range("H7").Value, LookIn:=xlValues, LookAt:=xlWhole) 
36.
                 
37.
                If oFound Is Nothing Then 
38.
                    MsgBox Replace(Err1, "%1", .Range("H7").Value), vbExclamation, "Fehler . . ." 
39.
                Else 
40.
                    iZeile = oFound.Row 
41.
             
42.
                    If IsEmpty(Cells(iZeile, "D")) Then 'Test Auftrags-Volumen Leer 
43.
                       'Zellen kopieren und einfügen 
44.
                        For i = 0 To UBound(aQCells) 
45.
                           .Range(Trim(aQCells(i))).Copy 
46.
                            Cells(iZeile, "B").Offset(0, i).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
47.
                        Next 
48.
                    Else 
49.
                       'Spalte D/E aufaddieren 
50.
                        Cells(iZeile, "D").Value = Cells(iZeile, "D").Value + .Range("H29").Value 
51.
                        Cells(iZeile, "E").Value = Cells(iZeile, "E").Value + .Range("H33").Value 
52.
                    End If 
53.
                End If 
54.
            End With 
55.
            Wkb.Close False 
56.
        End If 
57.
    Next 
58.
 
59.
   'Sort weggelassen, scheint mir überflüssig zu sein 
60.
 
61.
    With Application 
62.
        .DisplayAlerts = True 
63.
        .AskToUpdateLinks = True 
64.
        .ScreenUpdating = True 
65.
    End With 
66.
 
67.
    ThisWorkbook.Save: MsgBox Msg1, vbInformation, "Datenimport . . ." 
68.
 End Sub 
69.
 
70.
'Mit dieser Funktion werden die Zellinhalte nur in den Zeilen mit Kostennummern (ab Spalte B) 
71.
'entsprechend dem Such-Kriterium 3 Zeichen + '.' + keine/weitere Zeichen (???.*) gelöscht 
72.
 
73.
Private Sub CleanUp(ByVal iColOffset) 
74.
    Dim iEndZeile As Long 
75.
     
76.
    ActiveSheet.AutoFilterMode = False 
77.
     
78.
    iEndZeile = Cells(Rows.Count, "A").End(xlUp).Row 
79.
     
80.
    With Range(Cells(iStartZeile - 1, "A"), Cells(iEndZeile, "A")) 
81.
        .AutoFilter Field:=1, Criteria1:=sFilter, Operator:=xlAnd, VisibleDropDown:=False 
82.
    End With 
83.
 
84.
    Range(Cells(iStartZeile, "B"), Cells(iEndZeile, "B").Offset(0, iColOffset)).Cells.Clear 
85.
 
86.
    ActiveSheet.AutoFilterMode = False 
87.
End Sub
Gruß Dieter
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Microsoft Office
Excel 2007: Sortierung ohne ins Datenblatt zu springen (2)

Frage von JoSiBa zum Thema Microsoft Office ...

Outlook & Mail
Outlook 2007 legt ost-dateien offenbar immer im ANSI-Format an (3)

Frage von coltseavers zum Thema Outlook & Mail ...

VB for Applications
gelöst Excel VBA Werte von 2 verschiedenen Sheets vergleichen und aktualisieren (4)

Frage von drimrim zum Thema VB for Applications ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (20)

Frage von Xaero1982 zum Thema Microsoft ...

Outlook & Mail
gelöst Outlook 2010 findet ost datei nicht (19)

Frage von Floh21 zum Thema Outlook & Mail ...

Netzwerkmanagement
gelöst Anregungen, kleiner Betrieb, IT-Umgebung (18)

Frage von Unwichtig zum Thema Netzwerkmanagement ...

Festplatten, SSD, Raid
M.2 SSD wird nicht erkannt (14)

Frage von uridium69 zum Thema Festplatten, SSD, Raid ...