Supportnet / Forum / Tabellenkalkulation

Hi zusammen, vor ein paar Tagen hab ich ein Programm gefunden, dass mir sehr gefallen würde, jedoch verstehe ich es nicht^^ Ich weiss nicht genau was ich für die Variabeln einsetzen muss damit alles so klappt wie ich es mir vorstelle--> Ich brauche Daten aus verschiedenen Arbeitsblättern in einer Tabelle einer bestimmten Datei untereinander aufgelistet. Der Datenbereich sollte dabei immer derselbe sein z.B. A1 bis A50.Könntet ihr mir bitte dazu erklären, was genau jeder dieser Schritte in unten angezeigten Programm macht und was ich alles einfügen muss??? (ein Beispiel dazu wäre sehr nett) Danke vielmals :) Der kleine Napoleon Daten aus externen Mappen lesen ohne diese zu öffnen Sub Read_All_Datas_from_defined_Workbooks_without_Opening() ´by Ramses ´Liest alle Daten aus geschlossenen Arbeitsblättern ´aus einem bestimmten Bereich ein. ´Alle eingelesenen Daten werden untereinander aufgelistet. ´Die Daten werden in Dateien mit dem Datei-Teilbegriff "Report" ´gesucht und eingelesen Dim i As Long, totFiles As Long Dim ColCounter As Integer, rowCounter As Long Dim n As Integer, k As Integer Dim gefFile As String, TeilName As String Dim Suchpfad As String, Suchbegriff As String, Dateiform As String Dim tmpPfad As String, tmpName As String, tmpFile As String Dim curWB As Workbook, tarwks As Worksheet, datWKS As String Dim oldStatus As Variant Dim myR1 As String, myR2 As String, myR3 As String Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", "D:") ´Application.DefaultFilePath) If Suchpfad = "" Then Exit Sub Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls") If Dateiform = "" Then Exit Sub Application.ScreenUpdating = True ´zur definitiven Ausführung auf False setzen oldStatus = Application.StatusBar ´ZählVariablen setzen rowCounter = 1 ColCounter = 2 ´Variablen für aktive Mappe setzen Set curWB = Workbooks(ThisWorkbook.name) Set tarwks = curWB.Worksheets("Tabelle1") ´zu kopierende Bereiche definieren ´Variablen für den DateiNamen der entsprechenden Tabelle ersezten TeilName = "Report" ´Tabellenname in der Mappe mit dem Teilstring "TeilName" datWKS = "Summary" ´zu lesende Bereich definieren myR1 = datWKS & "´!R3C2" myR2 = datWKS & "´!R17C4" ´Datumsformat in Spalte D zuweisen Columns(4).NumberFormat = "m/d/yyyy" ´Dateisuche starten With Application.FileSearch .LookIn = Suchpfad .SearchSubFolders = False .FileName = Dateiform ´Wenn gefunden,.. ´Schleifenauswertung beginnen If .Execute() > 0 Then totFiles = .FoundFiles.count Application.StatusBar = "Total " & totFiles & " gefunden" For i = 1 To .FoundFiles.count gefFile = .FoundFiles(i) ´Namen und String zusammensetzen tmpName = Right(gefFile, Len(gefFile) - InStrRev(gefFile, "\", -1)) tmpPfad = Left(gefFile, Len(gefFile) - Len(tmpName)) tmpFile = "´" & tmpPfad & "[" & tmpName & "]" ´Die Formel für das Excel4-Macro muss im R1C1 - Format erstellt werden ´Auch die Rechteckklammern müssen eingebaut werden ´Hochkomma´s nicht vergessen !! ´´D:\[Muster.xls]Summary´!R3C2 If UCase(Left(Right(gefFile, Len(gefFile) - 3), Len(TeilName))) = UCase(TeilName) Then ´In Tabelle eintragen tarwks.Cells(rowCounter, 1) = Application.ExecuteExcel4Macro(tmpFile & myR1) tarwks.Cells(rowCounter, 2) = Application.ExecuteExcel4Macro(tmpFile & myR2) tarwks.Cells(rowCounter, 2).NumberFormat = "0.00%" ´Zwei neue Schleifen um die einzelnen zellen in ´den Zieldateien auszulesen ´Datenbereich von B23 : F39 einlesen For k = 23 To 39 For n = ColCounter To 6 myR3 = datWKS & "´!R" & k & "C" & n & ":R" & k & "C" & n tarwks.Cells(rowCounter, n + 1) = Application.ExecuteExcel4Macro(tmpFile & myR3) Next n rowCounter = rowCounter + 1 Next k rowCounter = rowCounter + 1 End If Next i End If End With Application.StatusBar = oldStatus Application.ScreenUpdating = True End Sub

hi all :)

2 beispiele :)

gruss nighty

Option Explicit
Sub SheetErfassung()
Dim Blätter As Integer
For Blätter = 1 To Sheets.Count - 1
Workbooks(1).Sheets(Blätter).Range("A1:A10").Copy Workbooks(1).Sheets(Sheets.Count).Range("A" & Workbooks(1).Sheets(Sheets.Count). _
UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Next Blätter
End Sub

Option Explicit
Sub MappenErfassung()
Dim Mappen As Integer
With Application.FileSearch
.NewSearch
.LookIn = "C:\ExcelMappen"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Mappen = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Mappen)
Workbooks(2).Sheets(1).Range("A1:C10").Copy _
Workbooks(1).Sheets(1).Range("A" & Workbooks(1).Sheets(1). _
UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 & ":C" & _
Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(2).Close
Next Mappen
End If
End With
End Sub

hi all :)

oder hier noch ein beispiel was von einer unbestimmten anzahl von mappen eine unbestimmte anzahl von sheets einen festgelegten bereich im geschlossenen zustand ausliesst

gruss nighty

Option Explicit
Sub makro01()
Dim Lager As String
Dim Zeilen As Long
Dim Spalten As Integer
Dim Tabellen As Integer
Dim Dateien As Integer
Dim DateiName As String
Dim Zelle As Range
Zeilen = 1
Spalten = 1
With Application.FileSearch
.NewSearch
.LookIn = "C:\temp"
.SearchSubFolders = False
.Filename = "*.*"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
For Tabellen = 1 To Sheets.Count
For Each Zelle In Range("A16:H35")
Lager = ExecuteExcel4Macro("´C:\temp\" & "[" & _
Mid(.FoundFiles(Dateien), Len(.LookIn) + 2, Len(.FoundFiles(Dateien))) & "]" & _
Sheets(Tabellen).Name & "´!" & Zelle.Address(, , xlR1C1))
If Lager <> "0" Then
Cells(Zeilen, Spalten) = Lager
Spalten = Spalten + 1
If Spalten > 8 Then
Spalten = 1
Zeilen = Zeilen + 1
End If
End If
Next Zelle
Next Tabellen
Next Dateien
End If
End With
End Sub

hi all :)

das duerfte spielraum fuer experimente sein :)))

gruss nighty

• Notebook schaltet sich nicht aus - Netzeil verursacht Neustart