Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 14:36:42
Texte Zählen bzw. Anzahl zusammenzählen
18.04.2024 14:27:59
Datum wenn Betrag bei jährl. wechselnder Reduzierung 0 wird
18.04.2024 14:14:51
Summewenn letzter Eintrag
18.04.2024 12:28:32
Formelfehler aufgrund Einfügen einer Zeile
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1824to1828
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1824to1828
1824to1828
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Auswertungstool

Auswertungstool
13.04.2021 20:55:45
Anna
Hallo zusammen,
ich versuche gerade ein Auswertungstool zu erstellen aber habe hierzu leider noch ein paar Fragen, welche ich im Laufe der Zeit hier noch stellen werde.
Folgendes funktioniert bereits mit dem unten beigefügten Code:
Bei diesem Tool sollen mehrere Excel-Dateien (Kalkulationen), welche auf einem bestimmten Pfad X liegen in eine weitere Excel-Datei (Auswertung) eingelesen und bestimmte Zellen übernommen werden.
Jetzt habe ich allerdings das erste folgende Problem:
In dieser Auswertung werden aus den Kalkulationen leider nur die Zellen (Bsp. A1, B1, C1 etc.) in die Zeile 4 (wie festgelegt) übernommen.
In den Zellen (Bsp. A2, B2, C2 etc.) der Kalkulation, stehen allerdings weitere relevante Werte, welche ich ebenfalls in der Auswertung in der nächsten Zeile 5 benötige.
Die Werte der Zellen (Bsp. A3, B3, C3 etc.) der Kalkulation, benötige ich dann wieder in der nächsten Zeile 6 in der Auswertung.
Und immer so weiter…
Kann mir daher bitte jemand mitteilen, wie ich die weiteren Werte in die jeweils nächste Zeile übertragen bekomme?
Vielen Dank schonmal 😊
Option Explicit 

Public Sub ExcelDateienAuswerten()
Dim strDateiname As String
Dim strPfad      As String
Dim lngZeile     As Long
'Pfadangabe, in dem die zu lesenden Excel-Datei (*.xls) liegen
strPfad = "C:\Users\Anna\Documents\"
'Den 1. Dateinamen holen
strDateiname = Dir(strPfad & "*.xls")
'Startzeile festlegen
lngZeile = 4
'Solange ein Dateiname gelesen wird
Do While Not strDateiname = ""
'Datei verarbeiten
Call TabVerarb(strPfad & strDateiname, lngZeile)
'nächsten Dateinamen holen
strDateiname = Dir()
'Zeilenzähler erhöhen
lngZeile = lngZeile + 1
Loop
End Sub



Public Sub TabVerarb(strPfad As String, lngZeile As Long)

Dim strMeSH As String

Dim strDatei As String

Dim strSH As String

'Dateinamen extrahieren

strDatei = Split(strPfad, "\")(UBound(Split(strPfad, "\")))

'Eigenen Namen merken

strMeSH = ActiveWorkbook.Name

'Datei öffnen

Workbooks.Open Filename:=strPfad

With Workbooks(strMeSH)

'Dateinamen und auszuwertenden Zellen übertragen

.Sheets("Tabelle1").Cells(lngZeile, 1) = strDatei

.Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Kalkulation").Range("A1").Value

.Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Kalkulation").Range("A2").Value

.Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Kalkulation").Range("A3").Value

'Quelldatei schließen

Workbooks(strDatei).Saved = True

Workbooks(strDatei).Close

End With

End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auswertungstool
13.04.2021 22:16:48
Yal
Hallo Anna,
wenn ich deine Erklärung richtig deute, sollte nicht 
    .Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Kalkulation").Range(" _
A1").Value
.Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Kalkulation").Range(" _
A2").Value
.Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Kalkulation").Range(" _
A3").Value

sondern 
    .Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Kalkulation").Range(" _
A1").Value
.Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Kalkulation").Range(" _
B1").Value
.Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Kalkulation").Range(" _
C1").Value

stehen. oder?
Verwendet Variable für die Quell- und ZielTabelle. Und eine Schleife für die Zeilen. 
Dim wQ As Worksheet 'Q für Quelle
Dim wZ As Worksheet ' Z für Ziel
Dim i
Dim r
Set wQ = Workbooks(strDatei).Sheets("Kalkulation")
Set wZ = Workbooks(strMeSH).Sheets("Tabelle1")
r = wZ.Range("A9999").End(xlUp).Row 'letzte befüllte Zeile in Spalte A der Zieltabelle
For i = 1 To 6
r = r + 1
wZ.Cells(r, 1) = wQ.Parent.Name
wZ.Cells(r, 2) = wQ.Cells(i, 1).Value
wZ.Cells(r, 3) = wQ.Cells(i, 2).Value
wZ.Cells(r, 4) = wQ.Cells(i, 3).Value
Next
wQ.Parent.Close save:=False

Dies soll der Block zwischen "With"/"End With" ersetzen.
strDatei brauchst Du nicht mehr.
VG
Yal
Anzeige
AW: Auswertungstool
14.04.2021 19:15:57
Anna
Hallo Yal,
du hast natürlich vollkommen recht.
So wie du es richtig erkannt hast, ist folgendes korrekt:
Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Kalkulation").Range("A1").Value
Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Kalkulation").Range("B1").Value
Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Kalkulation").Range("C1").Value
Ich glaube wir sind auf dem richtigen Weg! 😊
Aber leider funktioniert diese Lösung nicht ganz, da ich es wahrscheinlich falsch verstanden habe.
Ich habe dir einmal zwei Tabellen als Beispiel angefügt.
https://www.herber.de/bbs/user/145532.xlsx
https://www.herber.de/bbs/user/145533.xlsm
Alle Artikelnummern aus der Kalkulation sollen in die Auswertung eingelesen werden.
Hierbei soll die Spalte „Fertigungszuschlag“ beispielsweise nicht mit übertragen werden.
Außerdem kann es ebenfalls sein, dass andere Kalkulationen weniger oder mehr Artikelnummern aufweisen können.
Vielleicht könntest du mir ja den richtigen Code vollständig zusenden.
Es wäre super nett von dir, wenn du dir das Ganze nochmal anschauen könntest. 😊
Danke dir!
Option Explicit 

Public Sub ExcelDateienAuswerten()
Dim strDateiname As String
Dim strPfad      As String
Dim lngZeile     As Long
'Pfadangabe, in dem die zu lesenden Excel-Datei (*.xls) liegen
strPfad = "C:\Users\Anna\Documents\Test\"
'Den 1. Dateinamen holen
strDateiname = Dir(strPfad & "*.xls")
'Startzeile festlegen
lngZeile = 4
'Solange ein Dateiname gelesen wird
Do While Not strDateiname = ""
'Datei verarbeiten
Call TabVerarb(strPfad & strDateiname, lngZeile)
'nächsten Dateinamen holen
strDateiname = Dir()
'Zeilenzähler erhöhen
lngZeile = lngZeile + 1
Loop
End Sub



Public Sub TabVerarb(strPfad As String, lngZeile As Long)

Dim strMeSH As String

Dim strDatei As String

Dim strSH As String

'Dateinamen extrahieren

strDatei = Split(strPfad, "\")(UBound(Split(strPfad, "\")))

'Eigenen Namen merken

strMeSH = ActiveWorkbook.Name

'Datei öffnen

Workbooks.Open Filename:=strPfad

With Workbooks(strMeSH)

'Dateinamen und auszuwertenden Zellen übertragen

.Sheets("Tabelle1").Cells(lngZeile, 1) = strDatei

.Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Kalkulation").Range("A2").Value

.Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Kalkulation").Range("B2").Value

.Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Kalkulation").Range("C2").Value

.Sheets("Tabelle1").Cells(lngZeile, 5) = Workbooks(strDatei).Sheets("Kalkulation").Range("D2").Value

.Sheets("Tabelle1").Cells(lngZeile, 6) = Workbooks(strDatei).Sheets("Kalkulation").Range("F2").Value

'Quelldatei schließen

Workbooks(strDatei).Saved = True

Workbooks(strDatei).Close

End With

End Sub

Anzeige
AW: Auswertungstool
14.04.2021 20:17:28
Yal
Hallo Anna,
hier das komplette Code.
Beachte, dass Du die Bibliothek "Microsoft Scripting Runtime" anbinden muss, um die Objekt "FileSystemObject", "Folder" und "File" zu verwenden:
im Visual Basic Editor unter "Extras", "Verweis..." runter bis "Microsoft scripting Runtime", dann Hacken dran.
Ich habe das Datei_öffnen und Datei_schliessen separat behandelt. Die reine Datenverarbeitung ist dann cleaner.
Alles mit "Q" ist Quelle, "Z" Ziel. 
Private wbQ As Workbook
Private wsZ As Worksheet
Public Sub ExcelDateienAuswerten()
Dim strDateiname As String
Dim strPfad      As String
Dim lngZeile     As Long
Dim FSO As New FileSystemObject 'Achtung mit Verweis auf "Micorsoft Scripting Runtime"
Dim FD As Folder
Dim F As File
Const cPfad = "C:\Users\Josef\Documents\Test\"
Set FD = FSO.GetFolder(cPfad)
If FD Is Nothing Then
MsgBox "Pfad nicht gefunden: " & vbCr & cPfad
Exit Sub
End If
Set wsZ = ThisWorkbook.Worksheets("Tabelle1")
For Each F In FD.Files
Select Case LCase(Mid(F.Name, InStrRev(F.Name, ".")))
Case ".xls", ".xlsx", ".xlsm", ".xlsb"
Datei_öffnen F.Path
If Not wbQ Is Nothing Then Datei_verarbeiten
Datei_schliessen
Set wbQ = Nothing
End Select
Next
End Sub
Private Sub Datei_öffnen(Pfad As String)
Workbooks.Open Pfad
Set wbQ = ActiveWorkbook
End Sub
Private Sub Datei_schliessen()
wbQ.Close SaveChanges:=False
End Sub
Private Sub Datei_verarbeiten()
Dim rQ, rZ
With wbQ.Worksheets("Kalkulation")
For rQ = 2 To .Range("A9999").End(xlUp).Row
rZ = wsZ.Range("A9999").End(xlUp).Row + 1
wsZ.Cells(rZ, 1) = wbQ.Name
wsZ.Cells(rZ, 2) = .Cells(rQ, 1)
wsZ.Cells(rZ, 3) = .Cells(rQ, 2)
wsZ.Cells(rZ, 4) = .Cells(rQ, 3)
wsZ.Cells(rZ, 5) = .Cells(rQ, 4)
wsZ.Cells(rZ, 6) = .Cells(rQ, 5)
Next
End With
End Sub

Viel Erfolg damit. Rückmeldung wäre nett.
VG
Yal
Anzeige
AW: Auswertungstool
14.04.2021 23:20:17
Anna
Hallo Yal,
vielen lieben dank, es funktioniert!!! :-)
Davon war ich ja mal Meilen weit entfernt und hätte ich mit meinem Lösungsansatz nie hinbekommen.
Eine Kleinigkeit noch:
Wenn ich eine weitere Spalte in der Kalkulation einfüge, dann müsste ich doch den Code so erweitern oder? wsZ.Cells(rZ, 7) = .Cells(rQ, 6)
Leider kommt hier dann die Fehlermeldung: "Objektvariable nicht festgelegt (Fehler 91)"
Dies passiert ebenfalls wenn ich eine Quelle oder ein Ziel ändern möchte. Z.B. von wsZ.Cells(rZ, 6) = .Cells(rQ, 5) auf wsZ.Cells(rZ, 7) = .Cells(rQ, 5)
Danke und Grüße
Anna
Anzeige
AW: Auswertungstool
15.04.2021 11:31:06
Yal
Hallo Anna,
deine Annahme ist richtig: 
wsZ.Cells(rZ, 7) = .Cells(rQ, 6)

Dass es zu eine Fehler kommt, ist merkwürdig und nicht nachvollziehbar. Anscheinend verstellt sich etwas, was ich nicht sehen kann. Es bedeutet auch, dass auch ohne Änderung beim zweiten Lauf auch eine Fehler hoch kommen sollte. Bei der Fehlermeldung geh auf "Debug" und schaue genau, wo der Fehler passiert. Du kannst auch den Code in Schritt-Nodus durchlaufen lassen (F8).
Aber spätestens nachdem Du Excel neugestartet hast, sollte diesen Code inkl. deine Ergänzung richtig laufen.
Vielleicht etwas, was helfen könnte: die Value der Quelle anstatt die Quelle selbst zu übertragen 
        wsZ.Cells(rZ, 2) = .Cells(rQ, 1).Value
wsZ.Cells(rZ, 3) = .Cells(rQ, 2).Value
wsZ.Cells(rZ, 4) = .Cells(rQ, 3).Value
wsZ.Cells(rZ, 5) = .Cells(rQ, 4).Value
wsZ.Cells(rZ, 6) = .Cells(rQ, 5).Value

VG
Yal
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige