Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1632to1636
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
Inhaltsverzeichnis

Makro-Optimierung

Makro-Optimierung
04.07.2018 12:59:54
Michael
Hallo Zusammen,
seit Jahren verwende ich ein Makro, um von Dateien aus anderen Dateien Daten zu holen. Das Makro läuft fehlerlos.
Bisher habe ich immer aus einer Datei nur Daten aus einer anderen Datei holen müssen.
Nun tritt es häufiger auf, das ich aus mehreren Dateien Daten holen muss. In meiner Not habe ich das Makro einfach vervielfältigt. Das ist sehr umständlich.
Gibt es vielleicht eine Möglichkeit, den vorhandenen Parameterbereich im Tabellenblatt vom Makro so "abzugreifen", dass man das Makro nur einmal benötigt.
Durch eine Auswahl [am besten in einer Zelle] soll das Makro beim Start, entsprechend der Auswahl, die benötigten Parameter (Dateiname, Pfad, Tabellenblatt, Kopierbereich und Einfügeposition) dann im Makro verwenden.
Hier eine Beispieldatei: https://www.herber.de/bbs/user/122476.xlsb
Vielen Dank für Eure Unterstützung
Michael

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

Betreff
Datum
Anwender
Anzeige
AW: Makro-Optimierung
04.07.2018 13:13:40
ChrisL
Hi Michael
Den Code habe ich nicht weiter studiert oder getestet...
Sub t()
With Worksheets("Übertragungsparameter")
Call Block_holen(.Range("B2"), .Range("B3"), .Range("B4"), .Range("B5"), .Range("B6"))
Call Block_holen(.Range("B9"), .Range("B10"), .Range("B11"), .Range("B12"), .Range("B13"))
Call Block_holen(.Range("B16"), .Range("B17"), .Range("B18"), .Range("B19"), .Range("B20"))
End With
End Sub
Private Sub Block_holen(Pfad As String, DateiName As String, Blatt As String, Bereich As String, _
Ziel As Range)
Dim vntFiles() As Variant, strFile As String, lngI As Long
If MsgBox("Wollen Sie die Daten aktualisieren?", _
vbYesNo + vbQuestion, "Aktualisierungsabfrage") = vbNo Then
Exit Sub
End If
On Error GoTo Block1_holen_Error
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
.DisplayAlerts = False
End With
With Tabelle1
Pfad = .Range("B2").Value
If Right(Pfad, 1)  "\" Then Pfad = Pfad & "\"
Blatt = .Range("B4").Value
Bereich = .Range("B5").Value
strFile = Dir(Pfad & "*" & .Range("B3").Value, vbNormal)
End With
Do While strFile  ""
ReDim Preserve vntFiles(lngI)
vntFiles(lngI) = strFile
lngI = lngI + 1
strFile = Dir
Loop
If UBound(vntFiles) > 0 Then
With frmFiles
.lstFiles.List = vntFiles
.Show
End With
If lngSelection > -1 Then
DateiName = vntFiles(lngSelection)
Else
Exit Sub
End If
Else
DateiName = vntFiles(0)
End If
Set Ziel = Tabelle2.Range("Einfügeposition_B1")
If GetDataClosedWB(Pfad, DateiName, Blatt, Bereich, Ziel) Then
MsgBox "Die Daten wurden importiert!" & vbLf & _
"Bitte die Werte kontrollieren!", vbInformation, "Hinweis"
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
.DisplayAlerts = True
End With
Set Ziel = Nothing
Exit Sub
Block1_holen_Error:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
.DisplayAlerts = True
End With
Set Ziel = Nothing
MsgBox "Fehler in der Zeile " & Erl & ", Fehlernummer: " & Err.Number _
& " (" & Err.Description & _
") in procedure Block1_holen im Modul mdl_Uebertragen"
End Sub
cu
Chris
Anzeige
AW: Makro-Optimierung
04.07.2018 13:35:32
Michael
Hallo Chris,
funktioniert leider noch nicht ganz richtig, was aber nur an meiner unvollständigen Beschreibung liegt:
1) Es soll nur ein Makro, entsprechend der Auswahl in Zelle B23 ausgeführt werden.
2) Die Einfügepositionen in den Zellen B6,B13 und B20 sind Bereichsnamen. An dieser Stelle im Makro gibt es daher keinen Verweis auf diese drei Zellen, sondern ich habe den Bereichnamen direkt im Makro eingefügt.
Ich bedanke mich ganz herzlich für Deine Mühe und hoffe, dass der Restnoch klappt?
Gruß
Michael
AW: Makro-Optimierung
04.07.2018 13:20:06
Daniel
Hi
für alle Daten, die du aus den Zellen liest:
Pfad = Worksheetfunction.match(range("B23").Value, columns(1), 0) + 1, 2)
DateiName = Worksheetfunction.match(range("B23").Value, columns(1), 0) + 2, 2)
Blatt = Worksheetfunction.match(range("B23").Value, columns(1), 0) + 3, 2)
usw.
Gruß Daniel
Anzeige
AW: Makro-Optimierung - Korrektur
04.07.2018 13:23:05
Daniel
Sorry sieht natürlich so aus:
with Tabelle1
Pfad = .Cells(Worksheetfunction.match(.Range("B23").Value, columns(1), 0) + 1, 2)
DateiName = .Cells(Worksheetfunction.match(.range("B23").Value, columns(1), 0) + 2, 2)
Blatt = .Cells(Worksheetfunction.match(.range("B23").Value, columns(1), 0) + 3, 2)
usw
end with

fast!
04.07.2018 14:13:22
Michael
Hallo Daniel,
Deine Lösung funktioniert sehr gut!
Ich habe nur noch ein kleines Problem mit dem Einfügebreich:
In den Zellen für den Einfügebereich habe ich einen Namen für den Einfügebereich hinterlegt. Darum kann ich Deine Lösung für den Einfügebereich noch nicht verwenden.
Hast Du für dieses Problem auch noch eine Lösung?
Vielen Dank und Gruß
Michael
Anzeige
Funktioniert zu 100%
04.07.2018 14:27:43
Michael
Hallo Daniel,
das kleine Problem mit der Einfügeposition habe ich sogar selber hinbekommen.
Vielen Dank für Deine feine Lösung.
Gruß
Michael
AW: Makro-Optimierung
04.07.2018 14:31:48
Daniel
Hi
wo ist da das Problem?
ob in der Range jetzt der Name des Zellbereichs als Text steht oder wieder der Verweis auf eine andere Zelle mit dem Namen ist doch egal:
with tabelle1
Set Ziel = Tabelle2.Range(.Cells(Worksheetfunction.match(.Range("B23").Value, columns(1), 0) +  _
5, 2).value)
end with
Gruß Daniel
AW: Makro-Optimierung
04.07.2018 20:23:43
Michael
Hallo Daniel,
nach einigen Versuchen habe es, fast wie Du, so gelöst:
With Tabelle1
Pfad = .Cells(WorksheetFunction.Match(.Range("B23").Value, Columns(1), 0) + 1, 2)
DateiName = .Cells(WorksheetFunction.Match(.Range("B23").Value, Columns(1), 0) + 2, 2)
Blatt = .Cells(WorksheetFunction.Match(.Range("B23").Value, Columns(1), 0) + 3, 2)
Bereich = .Cells(WorksheetFunction.Match(.Range("B23").Value, Columns(1), 0) + 4, 2)
i = .Cells(WorksheetFunction.Match(.Range("B23").Value, Columns(1), 0) + 5, 2)
End With
Set Ziel = Range(i)
Nochmals vielen Dank
Gruß
Michael
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige