|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
 Daten aus bestimmte Zellen auslesen |
09.01.2017 11:59:40 |
Al |
|
|
|
09.01.2017 12:04:35 |
Al |
|
|
|
09.01.2017 13:21:45 |
Al |
|
|
|
09.01.2017 14:38:55 |
Bm |
|
|
Von:
Al |
Datum:
09.01.2017 11:59:40 |
Views:
1307 |
Rating:
|
Antwort:
|
Thema:
Daten aus bestimmte Zellen auslesen |
|
Hallo zusammen,
ich habe ein Makro mit dem ich Daten aus anderen Excelblättern auslesen möchte. Dies klappt soweit gut, allerdings greift es in den Codezeilen
wsZ.Cells(zeileZ, "E") = ws.Cells(letzteZeile, "L")
wsZ.Cells(zeileZ, "F") = ws.Cells(letzteZeile, "M")
auf die letzte Zeile zu. Diese ist wie folgt definiert:
letzteZeile = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
Leider ist diese Definition nicht ganz korrekt, da die Werte in den auszulesenden Exceldateien nicht die letzten sind. Es soll folgende Bedingung dafür gelten:
Wenn in Spalte D das Wort "Stahlgewicht" steht, dann sollen aus der entsprechenden Zeilen die Werte aus der Spalte L & M ausgelesen werden und in der Zieldatei in E und F eingesetzt werden.
Hat jemand eine Idee? Meine VBA-Kenntnisse sind eher bescheiden, daher hoffe ich auf eure Hilfe.
Zur Verdeutlichung soll anbei das Makro aufgeführt werden:
Option Explicit
Sub DatenAuslesen()
Dim ergebnis As Long
Dim fd As FileDialog
Dim fil As File
Dim fol As Folder
Dim fso As FileSystemObject
Dim letzteZeile As Long
Dim letzteZeileZ As Long
Dim pfad As String
Dim pos As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim wsZ As Worksheet ' Zielblatt
Dim zeichNr As String
Dim zeileZ As Long
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.InitialFileName = ThisWorkbook.Path & "\"
ergebnis = fd.Show
If ergebnis = 0 Then
' MsgBox Prompt:="Abbruch durch den Benutzer"
Exit Sub
End If
pfad = fd.SelectedItems(1)
Set wsZ = ThisWorkbook.Worksheets("Ziel")
letzteZeileZ = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row
Set fso = New FileSystemObject
Set fol = fso.GetFolder(pfad)
zeileZ = letzteZeileZ + 1
For Each fil In fol.Files
If fil.Name Like "*.xls*" And _
Len(fil.Name) <= 25 Then
Set wb = Workbooks.Open(Filename:=fil.Path)
For Each ws In wb.Worksheets
letzteZeile = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
If ws.Cells(letzteZeile, "D") = "Stahlgewicht" Then
wsZ.Cells(zeileZ, "A") = ws.Range("F3")
wsZ.Cells(zeileZ, "B") = ws.Range("F4")
wsZ.Cells(zeileZ, "C") = ws.Range("O3")
' wsZ.Cells(zeileZ, "D") = ws.Range("L3") ' Alternative für Zeichnungsnummer
pos = InStrRev(fil.Name, ".")
zeichNr = Left$(fil.Name, pos - 1)
wsZ.Cells(zeileZ, "D") = zeichNr
wsZ.Cells(zeileZ, "E") = ws.Cells(letzteZeile, "L")
wsZ.Cells(zeileZ, "F") = ws.Cells(letzteZeile, "M")
zeileZ = zeileZ + 1
End If
Next ws
wb.Close SaveChanges:=False
End If
Next fil
Set fso = Nothing
End Sub |
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
Daten aus bestimmte Zellen auslesen |
09.01.2017 11:59:40 |
Al |
|
|
|
09.01.2017 12:04:35 |
Al |
|
|
|
09.01.2017 13:21:45 |
Al |
|
|
|
09.01.2017 14:38:55 |
Bm |
|
|