Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1020to1024
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Makro zur Koordination mehrerer Excel-Dateien
02.11.2008 21:11:45
Kurt
Hallo Forum,
ich denke bereits seit längerem über das nachfolgend beschriebene Problem nach und hoffe, dass mir einer der vielen klugen Köpfe hier helfen kann.
In einem Netzwerk liegen an verschiedenen Orten Excel-Dateien. In jeder dieser Dateien befinden sich auf verschiedenen Tabellenblättern vereinzelt Informationen die ich in einer separaten Excel-Datei zusammenführen möchte. Allen Excel-Dateien gemeinsam ist ein Suchkriterium (z.B. "Name1"). Die Zeile, in der "Name1" auftaucht soll dann komplett in die separate Excel-Datei kopiert werden. Die Schritte des gesamten VBA sind folgende:
1. Auswahl der Excel-Dateien, aus denen Informationen (zeilenweise) kopiert werden sollen
2. Finden der Zeilen, die das Suchkriterium enthalten
3. Kopieren der Zeilen, die das Suchkriterium enthalten
4. Untereinanderschreiben der "Suchzeilen" in separater Excel-Datei
5. Löschen doppelter Einträge
Ich habe schon viel herumprobiert, aber so richtig zum Ziel bin ich noch nicht gekommen.
Für ein paar Ideen wäre ich sehr dankbar. Auch Code-Stücke helfen mir weiter, da ich gerade dabei bin mich in VBA einzufinden.
Grüße,
Kurt

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro zur Koordination mehrerer Excel-Dateien
02.11.2008 21:29:28
Tino
Hallo,
"In einem Netzwerk liegen an verschiedenen Orten Excel-Dateien"
und
"Auswahl der Excel-Dateien, aus denen Informationen (zeilenweise) kopiert werden sollen"
Die allererste Gegenfrage die mir in den Sinn kommt, ist bekannt wo diese Dateien liegen?
Schließlich kann ein Netzwerk recht groß sein!
Gruß Tino
AW: Makro zur Koordination mehrerer Excel-Dateien
02.11.2008 21:41:30
Kurt
Hallo Tino,
grundsätzlich ist es bekannt wo die Dateien liegen. Allerdings soll der Ort frei wählbar sein. Das habe ich auch bereits mit dem Befehl

f = Application.GetOpenFilename


hinbekommen. Allerdings nur für eine Datei.
Grüße,
Kurt

Anzeige
AW: Makro zur Koordination mehrerer Excel-Dateien
02.11.2008 21:52:00
Tino
Hallo,
versuche mal was aufzubauen, braucht aber ein wenig.
Gruß Tino
AW: Makro zur Koordination mehrerer Excel-Dateien
02.11.2008 22:50:00
Tino
Hallo,
hier mal ein erster entwurf.
Modul Modul1
Option Explicit 
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long 
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 
 
Public Type BROWSEINFO 
    hOwner As Long 
    pidlRoot As Long 
    pszDisplayName As String 
    lpszTitle As String 
    ulFlags As Long 
    lpfn As Long 
    lParam As Long 
    iImage As Long 
End Type 
 
'Ruft das Dialogfeld zur Ordnerauswahl auf 
Function GetDirectory(Msg) As String 
Dim bInfo As BROWSEINFO 
Dim path As String 
Dim r As Long, x As Long, pos As Integer 
With bInfo 
    .pidlRoot = 0& 
    .lpszTitle = Msg 
    .ulFlags = &H1 
End With 
x = SHBrowseForFolder(bInfo) 
path = Space$(512) 
r = SHGetPathFromIDList(ByVal x, ByVal path) 
If r Then 
    pos = InStr(path, Chr$(0)) 
    GetDirectory = Left(path, pos - 1) 
Else 
    GetDirectory = "" 
End If 
End Function 
Dim objMappe As Workbook 
Dim Suchbegriff As String 
Dim iZelle As Long 
 
'StartMakro**************************************************** 
Sub ErstelleNeue() 
Dim FSO As Object, F1 
Dim iSheet As Integer 
Dim Laufwerk As String 
 
Suchbegriff = InputBox("Geben Sie den Suchbegriff ein!") 
 If StrPtr(Suchbegriff) = 0 Then Exit Sub 
 
Laufwerk = GetDirectory("Bitte einen Ordner wählen") & "\" 
EventsAus False 
iZelle = 1 
Set objMappe = Workbooks.Add 
  'nicht benötigte Blätter löschen 
    For iSheet = objMappe.Sheets.Count To 2 Step -1 
     objMappe.Sheets(iSheet).Delete 
    Next iSheet 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set FSO = FSO.GetFolder(Laufwerk) 
 
For Each F1 In FSO.Files 
 If F1 Like "*.xls" Then 
  CheckFile CStr(F1) 
 End If 
Next F1 
 
 
 
EventsAus True 
End Sub 
 
Sub CheckFile(strFile As String) 
Dim objSuchMappe As Workbook 
Dim i As Integer 
Dim lngZeile As Long 
Dim FZelle As Range 
Set objSuchMappe = Workbooks.Open(strFile, False, True) 
With objSuchMappe 
    For i = 1 To .Worksheets.Count 
      
     For lngZeile = 1 To .Worksheets(i).UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row 
      Set FZelle = .Worksheets(i).Rows(lngZeile).Find(Suchbegriff, , xlValues, xlWhole) 
      If Not FZelle Is Nothing Then 
       .Worksheets(i).Rows(lngZeile).Copy objMappe.Worksheets(1).Rows(iZelle) 
       iZelle = iZelle + 1 
       Set FZelle = Nothing 
      End If 
     Next lngZeile 
    Next i 
End With 
objSuchMappe.Close False 
 
End Sub 
 
Sub EventsAus(bolWert As Boolean) 
Static iCalc As Integer 
 
 
With Application 
 If bolWert = False Then 
  iCalc = .Calculation 
  .Calculation = xlCalculationManual 
 Else 
  .Calculation = iCalc 
 End If 
 .ScreenUpdating = bolWert 
 .EnableEvents = bolWert 
 .DisplayAlerts = bolWert 
End With 
 
End Sub 


Gruß Tino

Anzeige
AW: Makro zur Koordination mehrerer Excel-Dateien
15.11.2008 19:59:00
Kurt
Hallo Tino,
danke für die schnelle Hilfe. Ich habe eben die Zeit gefunden und Deine Datei ausprobiert.
Funktioniert soweit super. Jetzt habe ich nur noch folgendes Problem.
Ich möchte aus verschiedenen Ordnern verschiedene Excel-Dateien auswählen können. Dies muss variable sein, da sich die Dateien auf dem Server stets ändern.
Vielleicht hast Du da ja noch eine Idee?
Besten Dank,
Kurt
AW: Makro zur Koordination mehrerer Excel-Dateien
02.11.2008 22:16:04
Daniel
Hi
mal so als Ansatz, der Folgende Code würde folgendes machen:
- alle Dateien, die in einem Array abgelegt sind, nacheinander öffen
- in der Datei alle Sheets nacheinander durchgehen
- in jedem Sheet in der ersten Spalte nach "Name1" filten
- die gefilterten Zeilen in ein Sheet mit Namen "Ergebnis" kopieren, die Zeilen werden untereinander kopiert
- danach die Dateien wieder schließen
vieleicht hilft dir das als ansatz, für ein spezifischeres Makro ist mir deine Beschreibung noch zu ungenau, vorallem der Bereich "Doppelte Löschen", aber dazu findest du genügend hier im Archiv.

Sub Daten_Zusammenfassen()
Dim Dateien(2) As String
Dim wb As Workbook
Dim sh As Worksheet
Dim i As Long
Dateien(0) = "C:\...\1.xls"
Dateien(1) = "C:\...\2.xls"
Dateien(2) = "C:\...\3.xls"
For i = 0 To UBound(Dateien)
Set wb = Workbooks.Open(Dateien(i), ReadOnly:=True)
For Each sh In wb.Worksheets
sh.Columns(1).AutoFilter Field:=1, Criteria1:="Name1"
sh.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
ThisWorkbook.Sheets("Ergebnis").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0). _
PasteSpecial xlPasteValues
Next sh
wb.Saved = True
wb.Close
Next i
End Sub


Gruß, Daniel

Anzeige
AW: Makro zur Koordination mehrerer Excel-Dateien
29.11.2008 21:08:25
Kurt
Hallo Daniel,
besten Dank für Deine Antwort. Ich habe es bei mir ausprobiert und bekommen immer folgenden Fehler
INdex außerhalb des gültigen Bereichs
Nach dem Debuggen kommt Dein Makro bis zur Auswahl der relevanten Zeilen und wählt diese auch aus. Der Kopiervorgang klappt dann aber nicht mehr.
Ist außerdem möglich, das Makro so anzupassen, dass "Name1" in einer beliebigen Spalte steht?
Solltest Du noch eine Idee haben, dann würde ich mich erneut über Deine brillante Hilfe freuen.
Grüße,
Kurt

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige