Frage stellen

VBA/Excel-Befehl für Übernahme von Zellen aus verschiedenen Dateien ohne diese zu öffnen

6.8k Aufrufe
Gefragt in Tabellenkalkulation von
Hallo,

vielleicht kann mir ja jemand helfen...
in der A-Spalte stehen die jeweiligen Dokumentennamen auf die zugeriffen werden soll,
um dann die bestimmte Zelle D6 des jeweiligen Dokuments auszulesen und diese auf
Spalte B zu übertragen. Kann mir da wer helfen? Existiert evtl. ein Excel-Befehl?

Lieben Gruß

Benny

19 Antworten

0 Punkte
Beantwortet von
Morgen Nighty und M.O.,

habe soeben das Makro von dir M.O. getestet und es erfüllt bislang zu 100% das was ich wollte ;). Bin überglücklich!

Danke!

Lieben Gruß Bennnny
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Benny,

danke für die Rückmeldung.

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo nochmal,

also es funktioniert doch nicht so ganz nach meinen Vorstellungen. Ich erläutere mal das Problem:
Also alle Arbeitsmappen sind durchlaufende Posten, soll heissen, diese werden in den Ordner kopiert und dort von der Arbeitsmappe Formel.xlsx geprüft (das prüfen habe ich mittels formeln gemacht-->funktioniert). Sind diese geprüftt werden diese Archiviert, also wieder kopieren und dann aus dem Ordner "Eigene Dateien" gelöscht. Wenn dann wieder genug neue zu Prüfende Arbeitsmappen da sind sollen diese nach dem gleichen Schema geprüft werden...usw. sagen wir jede zweite Woche oder so (spielt ja nicht so die Rolle wie oft)

Momentan muss ich jedes mal beim öffnen der Arbeitsmappe Formel.xlsx alles aktualisieren und das Makro ausführen. Gibt es da die möglichkeit ein Knopf für dieses Makro in der Arbeitsmappe zu integrieren, welches sich "Prüfen" nennt?

Weiter kommt beim Ausführen des Makro eine Anzeig ob ich "debuggen" möchte...was kann da falsch sein und warum muss ich die Datei nochmals öffnen beim direkten ausführen des Makro?

Ouh man Fragen über Fragen ;)

Gibt es irgendwelche Ideen?

Liebe Grüße

Bennnny
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Benny,

wie man eine Schaltfläche in ein Arbeitsblatt einfügt und dieser ein Makro zuweist, kannst du z.B. hier nachlesen.

Zur Nachfrage der Aktualisierung von externen Verknüpfungen kannst du mal hier nachlesen.

Löschst du die Dateien aus dem Verzeichnis, sind die Dateinamen jedoch noch in deiner Excel-Liste vorhanden, so erscheint das Öffnen-Fenster zum suchen der Datei.

Die Debuggen-Frage kommt, wenn ein Fehler im Makro ist. Klicke mal auf "Ja" und schau nach, welche Zeile im Makro gelb hinterlegt ist.

Löschst du die Dateinamen der geprüften und verschobenen Dateien aus deinem Arbeitsblatt? Falls du diese Daten behalten willst, so müsste man das Makro so umschreiben, dass es nur die Werte aus den jeweiligen Tabellen einliest und bei weiteren Durchläufen nur Zeilen abarbeitet, in denen noch keine Werte drin stehen.

Erkläre mal am Besten ganz genau, was du willst.

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.!

Du entschuldige ich war eine Woche im Urlaub...

Vielleicht versuch ich es nochmal genauer zu erklären ;)
In dem Ordner in welchem sich die Arbeitsmappe mit dem Makro befindet möchte ich zirka 200 Excel-Dateien mit dem gleichen Format einfügen. Diese sollen dann mittels Makro
fixierte Zellen aus den jeweiligen Dateien lesen und verarbeiten. Sind alle Dateien ok, entferne ich alle Dateien aus dem Ordner und füge beispielsweise 150 neue Dateien ein, die
dann geprüft werden sollen. Dieser Prozess wiederholt sich immer und immer wieder. Vielleicht nochmal mein bisheriger Makro:

Sub verknuepfungen()
'
' verknuepfungen Makro
'


Dim zeile As Long
Dim pfad As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad festlegen = Pfad der aktuellen Arbeitsmappe
pfad = ThisWorkbook.Path

'Schleife für das Erstellen der Verknüpfungen
'Beginnt ab Zeile 1 bis zur letzten beschriebenen Zeile
For zeile = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Falls Zelle nicht leer ist, werden die Verknüpfungen eingefügt
If IsEmpty(Cells(zeile, 1)) = False Then
ActiveSheet.Cells(zeile, 4).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Text & "]Sheet1'!C$2"
ActiveSheet.Cells(zeile, 5).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!C$7"
ActiveSheet.Cells(zeile, 6).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!D$11"
ActiveSheet.Cells(zeile, 7).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$15"
ActiveSheet.Cells(zeile, 8).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$16"
ActiveSheet.Cells(zeile, 9).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$17"
ActiveSheet.Cells(zeile, 11).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$10"
ActiveSheet.Cells(zeile, 12).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$11"
ActiveSheet.Cells(zeile, 13).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$2"
ActiveSheet.Cells(zeile, 14).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$3"
End If

Next zeile

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

Application.Goto Reference:="verknuepfungen"
ActiveWorkbook.Save
Range("C1:G8").Select
Range("C8").Activate
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range("C1:G9").Select
Range("G9").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("H12").Select
Application.Run "Formeltabelle.xlsm!verknuepfungen"
Sheets("Angebot").Select
Sheets("Angebot").Name = "Sheet1"
Range("A37").Select
ActiveWorkbook.Save
ActiveWindow.Close
Range("E6").Select
Application.Run "Formeltabelle.xlsm!verknuepfungen"
Application.WindowState = xlMinimized
ActiveWindow.Close
Application.WindowState = xlMinimized
Application.WindowState = xlMinimized
ActiveWindow.Close
Range("C23").Select
ActiveWindow.SmallScroll Down:=-6
Windows("0447-2012-12-S-687660030001-2012024025.xlsx").Activate
Windows("0440-2012-12-S-974370010001-2012024121.xlsx").Activate
Windows("0439-2012-12-S-611910010001-2012024000.xlsx").Activate
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.SmallScroll Down:=-3
Application.WindowState = xlMinimized
Windows("0413-2012-12-S-745640030001-2012024047.xlsx").Activate
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.SmallScroll Down:=-18
Windows("Formeltabelle.xlsm").Activate
Windows("Makro.xlsx").Activate
ActiveWindow.Close
ActiveWorkbook.Save
ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Bennnny,

ich hoffe, du hast dich in deinem Urlaub gut erholt.

Ich weiß jetzt zwar, was du willst, weiß aber immer noch nicht wie ich dir helfen soll bzw. kann.

Du schreibst in Anwort 13
Weiter kommt beim Ausführen des Makro eine Anzeige ob ich "debuggen" möchte...was kann da falsch sein und warum muss ich die Datei nochmals öffnen beim direkten ausführen des Makro?


Leider hast du keine meiner Fragen aus Anwort 14 beantwortet:
In welcher Zeile des Makros wird der Fehler angezeigt (ist gelb markiert - mal Debuggen auswählen)?
Welche Datei musst du noch einmal öffnen?
Bleiben die Namen der geprüften und inzwischen gelöschten Dateien in der Tabelle stehen oder werden diese und die erstellten Verknüpfungen gelöscht?

Du siehst, auch hier Fragen über Fragen ;-).

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.
Naja, kann man so nicht sagen, habe noch eine Prüfung ablegen müssen und dafür musste ich Urlaubstage opfern ;)
hehe^^ vielleicht bin ich einfach nur ein Hoffnungsloser Fall ;)
hast nen angenehmen Wochenstart hingelegt?

Es wird immer eine andere Zeile gelb markiert, aber immer eine von:
ActiveSheet.Cells(zeile, 4).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Text & "]Sheet1'!C$2"
ActiveSheet.Cells(zeile, 5).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!C$7"
ActiveSheet.Cells(zeile, 6).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!D$11"
ActiveSheet.Cells(zeile, 7).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$15"
ActiveSheet.Cells(zeile, 8).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$16"
ActiveSheet.Cells(zeile, 9).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$17"
ActiveSheet.Cells(zeile, 11).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$10"
ActiveSheet.Cells(zeile, 12).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$11"
ActiveSheet.Cells(zeile, 13).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$2"
ActiveSheet.Cells(zeile, 14).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$3"


allerdings meist die Zweite.

Weiter muss ich immer die Formeltabelle beim ausführen des Marko neu öffnen.

Lieben Gruß

Bennnny
0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)
Hallo Bennnny,

ich habe die Woche gut angefangen, danke :-).

Langsam nähern wir uns dem Problem, obwohl du immer noch nicht alles beantwortet hast ;-).

Ich habe dir mal den ersten Teil des Makros so umgeschrieben, dass nur die Werte aus den Tabellen eingefügt und keine Verknüpfungen. Die Werte werden auch nur dann eingefügt, wenn in der Spalte D bisher noch nichts steht.

Sub werte_einlesen()

Dim zeile As Long
Dim pfad As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad festlegen = Pfad der aktuellen Arbeitsmappe
pfad = ThisWorkbook.path

'Schleife für das Erstellen der Verknüpfungen
'Beginnt ab Zeile 1 bis zur letzten beschriebenen Zeile
For zeile = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Falls Zelle mit Dateinamen nicht leer ist und in Spalte D nichts steht, werden die Werte eingefügt

If IsEmpty(Cells(zeile, 1)) = False And IsEmpty(Cells(zeile, 4)) = True Then

ActiveSheet.Cells(zeile, 4) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Text & "]Sheet1'!" & Cells(2, 3).Address(ReferenceStyle:=xlR1C1)) 'C2 einlesen
ActiveSheet.Cells(zeile, 5) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(7, 3).Address(ReferenceStyle:=xlR1C1)) 'C7 einlesen
ActiveSheet.Cells(zeile, 6) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(11, 4).Address(ReferenceStyle:=xlR1C1)) 'D11 einlesen
ActiveSheet.Cells(zeile, 7) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(15, 2).Address(ReferenceStyle:=xlR1C1)) 'B15 einlesen
ActiveSheet.Cells(zeile, 8) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(16, 2).Address(ReferenceStyle:=xlR1C1)) 'B16 einlesen
ActiveSheet.Cells(zeile, 9) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(17, 2).Address(ReferenceStyle:=xlR1C1)) 'B17 einlesen
ActiveSheet.Cells(zeile, 11) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(10, 2).Address(ReferenceStyle:=xlR1C1)) 'B10 einlesen
ActiveSheet.Cells(zeile, 12) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(11, 2).Address(ReferenceStyle:=xlR1C1)) 'B11 einlesen
ActiveSheet.Cells(zeile, 13) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(2, 2).Address(ReferenceStyle:=xlR1C1)) 'B2 einlesen
ActiveSheet.Cells(zeile, 14) = ExecuteExcel4Macro("'" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!" & Cells(3, 2).Address(ReferenceStyle:=xlR1C1)) 'B3 einlesen

End If

Next zeile

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub


Damit sollte die Debuggen-Meldung beim Ausführen des Makros nicht mehr auftauchen, wenn du Datei aus dem Verzeichnis gelöscht hast.

Was du mit dem aufgezeichneten Teil des Makros bezwecken willst (Rahmen bei Zellen in der Arbeitsmappe Verknüpfungen entfernen und die Formeltabelle speichern?) weiß ich nicht. Aber da die Formeltabelle in dem aufgezeichneten Teil des Makros angesprochen wird, kommt es dort natürlich zu einer Fehlermeldung, wenn diese Tabelle nicht offen ist.

Gruß

M.O.
0 Punkte
Beantwortet von
Hey hey!

du MO leider komme ich momentan nicht mehr dazu mich damit intensiver zu beschäftigen. Zuviel Anderes zu erledigen. Muss das also etwas zurückstellen. Dank dir auf jeden Fall für deine Mühungen!!! Melde mich dann sicher wieder, wenn etwas Luft ist und du dann immer noch bereit sein solltest mich zu unterstützen ;)

Lieben Gruß und schöne Woche

Bennnny
Seite:
...