Office: Werte aus anderen Arbeitsmappen (dynamisch)

Hallo Dirk,
ich schaue mal.
- selektierbare Aktualisierung, (verstehe ich jetzt als - auf Knopfdruck - würde reichen)

LG Cam

 

Hallo Dirk,
hier mal eine Anschauung, ich hoffe du kannst das erkennen was du brauchst.
Danke im Voraus.
LG Cam

 

Hi,

INDIREKT ist einfach nur Bäh!

Da du sowieso VBA verwendest, sollte es doch nicht stören in Workbook_Open die entsprechenden Dateien zu öffnen und bei Workbook_Close wieder zu schließen. Dann funktioniert das mit INDIREKT. Aber bitte daran denken, nur die Dateien zu schließen, die nicht schon offen waren.

Alternativ kannst du auch per VBA die Formeln der Zellen, in denen bisher die INDIREKT-Funktionen stehen, anpassen. Am einfachsten geht dies, wenn du diese Zellen direkt in VBA ansprichst. Da musst du allerdings aufpassen, dass niemals Zeilen/Spalten in dem Blatt eingefügt oder gelöscht werden. Besser ist es den Zellen Namen zu verpassen und diese dann in VBA zu verwenden. Z.B. bekommt N15 den Namen "Bezug1" dann lautet der Code zum ausfüllen dieser Zelle:

Code:

With Uebersicht     'beachte: Uebersicht ist der Codename des Blattes!
    .Range("Bereich1").Formula = "='[" & .Range("B101") & "]" & .Range("C98") & "'!" & .Range("D98")
End With

Natürlich sollten B101 etc. ebenfalls Namen erhalten und entsprechend angesprochen werden.

 

Da kann ich dir nur zustimmen.

Dein unten genanntes Vorgehen klingt nach "Cool"
Ich versuche mich mal daran.
Vielen Dank für den Richtungsweiser.

Liebe Grüße Cam

 

Hallo Helmut,

dein Ansatz funktioniert perfekt, danke dafür.
Ist zwar ein heftiges Konstrukt aber das stört mich nicht wirklich.
Bin auch nicht vollends durch, denke so 90%
So sieht es bis jetzt, zu dem Thema, aus

Code:

Sub EK_Summen_Formeln()
Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next
' KalkSummen Formeln
   Uebersicht.Range("S_1").Formula = "='[" & Uebersicht.Range("B100").Offset(0, 0) & "]" & Uebersicht.Range("C98") & "'!" & Uebersicht.Range("D98")
   Uebersicht.Range("S_2").Formula = "='[" & Uebersicht.Range("B100").Offset(1, 0) & "]" & Uebersicht.Range("C98") & "'!" & Uebersicht.Range("D98")
   Uebersicht.Range("S_3").Formula = "='[" & Uebersicht.Range("B100").Offset(2, 0) & "]" & Uebersicht.Range("C98") & "'!" & Uebersicht.Range("D98")
   Uebersicht.Range("S_4").Formula = "='[" & Uebersicht.Range("B100").Offset(3, 0) & "]" & Uebersicht.Range("C98") & "'!" & Uebersicht.Range("D98")
   Uebersicht.Range("S_5").Formula = "='[" & Uebersicht.Range("B100").Offset(4, 0) & "]" & Uebersicht.Range("C98") & "'!" & Uebersicht.Range("D98")
   Uebersicht.Range("S_6").Formula = "='[" & Uebersicht.Range("B100").Offset(5, 0) & "]" & Uebersicht.Range("C98") & "'!" & Uebersicht.Range("D98")
   Uebersicht.Range("S_7").Formula = "='[" & Uebersicht.Range("B100").Offset(6, 0) & "]" & Uebersicht.Range("C98") & "'!" & Uebersicht.Range("D98")
   Uebersicht.Range("S_8").Formula = "='[" & Uebersicht.Range("B100").Offset(7, 0) & "]" & Uebersicht.Range("C98") & "'!" & Uebersicht.Range("D98")

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Sub MengenDSMBereiche_Formeln()
Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next
' Mat Formeln
   DSM.Range("AA11:AA129").Offset(0, 0).Formula = "='[" & Uebersicht.Range("B100").Offset(0, 0) & "]" & Uebersicht.Range("C98") & "'!F11:F129"
   DSM.Range("AA11:AA129").Offset(0, 1).Formula = "='[" & Uebersicht.Range("B100").Offset(1, 0) & "]" & Uebersicht.Range("C98") & "'!F11:F129"
   DSM.Range("AA11:AA129").Offset(0, 2).Formula = "='[" & Uebersicht.Range("B100").Offset(2, 0) & "]" & Uebersicht.Range("C98") & "'!F11:F129"
   DSM.Range("AA11:AA129").Offset(0, 3).Formula = "='[" & Uebersicht.Range("B100").Offset(3, 0) & "]" & Uebersicht.Range("C98") & "'!F11:F129"
   DSM.Range("AA11:AA129").Offset(0, 4).Formula = "='[" & Uebersicht.Range("B100").Offset(4, 0) & "]" & Uebersicht.Range("C98") & "'!F11:F129"
   DSM.Range("AA11:AA129").Offset(0, 5).Formula = "='[" & Uebersicht.Range("B100").Offset(5, 0) & "]" & Uebersicht.Range("C98") & "'!F11:F129"
   DSM.Range("AA11:AA129").Offset(0, 6).Formula = "='[" & Uebersicht.Range("B100").Offset(6, 0) & "]" & Uebersicht.Range("C98") & "'!F11:F129"
   DSM.Range("AA11:AA129").Offset(0, 7).Formula = "='[" & Uebersicht.Range("B100").Offset(7, 0) & "]" & Uebersicht.Range("C98") & "'!F11:F129"
' Hav's Formeln
   DSM.Range("AO47:AO54").Offset(0, 0).Formula = "='[" & Uebersicht.Range("B100").Offset(0, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"
   DSM.Range("AO47:AO54").Offset(0, 1).Formula = "='[" & Uebersicht.Range("B100").Offset(1, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"
   DSM.Range("AO47:AO54").Offset(0, 2).Formula = "='[" & Uebersicht.Range("B100").Offset(2, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"
   DSM.Range("AO47:AO54").Offset(0, 3).Formula = "='[" & Uebersicht.Range("B100").Offset(3, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"
   DSM.Range("AO47:AO54").Offset(0, 4).Formula = "='[" & Uebersicht.Range("B100").Offset(4, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"
   DSM.Range("AO47:AO54").Offset(0, 5).Formula = "='[" & Uebersicht.Range("B100").Offset(5, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"
   DSM.Range("AO47:AO54").Offset(0, 6).Formula = "='[" & Uebersicht.Range("B100").Offset(6, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"
   DSM.Range("AO47:AO54").Offset(0, 7).Formula = "='[" & Uebersicht.Range("B100").Offset(7, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Sub MengenLspBereiche_Formeln()
Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next
' LspMengen Formeln
   Lsp.Range("R8:R520").Offset(0, 0).Formula = "='[" & Uebersicht.Range("B100").Offset(0, 0) & "]" & Uebersicht.Range("C97") & "'!A8:A520"
   Lsp.Range("R8:R520").Offset(0, 1).Formula = "='[" & Uebersicht.Range("B100").Offset(1, 0) & "]" & Uebersicht.Range("C97") & "'!A8:A520"
   Lsp.Range("R8:R520").Offset(0, 2).Formula = "='[" & Uebersicht.Range("B100").Offset(2, 0) & "]" & Uebersicht.Range("C97") & "'!A8:A520"
   Lsp.Range("R8:R520").Offset(0, 3).Formula = "='[" & Uebersicht.Range("B100").Offset(3, 0) & "]" & Uebersicht.Range("C97") & "'!A8:A520"
   Lsp.Range("R8:R520").Offset(0, 4).Formula = "='[" & Uebersicht.Range("B100").Offset(4, 0) & "]" & Uebersicht.Range("C97") & "'!A8:A520"
   Lsp.Range("R8:R520").Offset(0, 5).Formula = "='[" & Uebersicht.Range("B100").Offset(5, 0) & "]" & Uebersicht.Range("C97") & "'!A8:A520"
   Lsp.Range("R8:R520").Offset(0, 6).Formula = "='[" & Uebersicht.Range("B100").Offset(6, 0) & "]" & Uebersicht.Range("C97") & "'!A8:A520"
   Lsp.Range("R8:R520").Offset(0, 7).Formula = "='[" & Uebersicht.Range("B100").Offset(7, 0) & "]" & Uebersicht.Range("C97") & "'!A8:A520"

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Wäre das so OK oder siehst du hier was völlig dummes ?
Funktionieren tut es jedenfalls.
Dir nochmal Danke für den Tip.

Liebe Grüße Cam

 

Hallo Cam,
ich hätte noch einen Weg über "ExecuteExcel4Macro"
Hier werden jedoch wirklich nur die Werte aus den einzelnen Kalkulationen geholt.
Soll heißen, zum aktualisieren müssen diese erneut eingelesen werden.
Beide Varianten haben ihren Charme.

Code:

Sub EK_Summen_holen()
'** Dimensionierung der Variablen
Dim Pfad As String, Datei As String, Blatt As String, Zelle As String

'** Angaben zur auszulesenden Zelle
Pfad = ActiveWorkbook.Path & "\"
Blatt = Range("C98")
bezug = Range("D98")

Application.ScreenUpdating = False
Application.EnableEvents = False

   '** Eintragen in Zellen
On Error Resume Next
With Uebersicht
   Datei = Range("B100")
   Range("N10").Value = GetValue(Pfad, Datei, Blatt, bezug)
   Datei = Range("B101")
   Range("N15").Value = GetValue(Pfad, Datei, Blatt, bezug)
   Datei = Range("B102")
   Range("N20").Value = GetValue(Pfad, Datei, Blatt, bezug)
   Datei = Range("B103")
   Range("N25").Value = GetValue(Pfad, Datei, Blatt, bezug)
   Datei = Range("B104")
   Range("N30").Value = GetValue(Pfad, Datei, Blatt, bezug)
   Datei = Range("B105")
   Range("N35").Value = GetValue(Pfad, Datei, Blatt, bezug)
   Datei = Range("B106")
   Range("N40").Value = GetValue(Pfad, Datei, Blatt, bezug)
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
Private Function GetValue(Pfad, Datei, Blatt, Zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
Dim arg As String

'Sicherstellen, dass der Pfad mit \ endet
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
   If Dir(Pfad & Datei) = "" Then
   GetValue = "datei Not Found"
   Exit Function
End If

'** Das Argument erstellen
arg = "'" & Pfad & "[" & Datei & "]" & Blatt & "'!" & Range(Zelle).Range("A1").Address(, , xlR1C1)

'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)

End Function

Ich glaube mir würde die Lösung von Helmut
(also die die du bereits weitestgehend umgesetzt hast)
besser gefallen.

Viele Grüße Dirk

 

Hi Cam,

im Prinzip ist dein Code korrekt. allerdings etwas umständlich. Wieso verwendest du keine With-Blöcke, so wie ich es gezeigt hatte? Dadurch wird so ein Code wesentlich übersichtlicher:

Code:

With Uebersicht
   .Range("S_1").Formula = "='[" & .Range("B100").Offset(0, 0) & "]" & .Range("C98") & "'!" & .Range("D98")
   .Range("S_2").Formula = "='[" & .Range("B100").Offset(1, 0) & "]" & .Range("C98") & "'!" & .Range("D98")
   .Range("S_3").Formula = "='[" & .Range("B100").Offset(2, 0) & "]" & .Range("C98") & "'!" & .Range("D98")
   .Range("S_4").Formula = "='[" & .Range("B100").Offset(3, 0) & "]" & .Range("C98") & "'!" & .Range("D98")
   .Range("S_5").Formula = "='[" & .Range("B100").Offset(4, 0) & "]" & .Range("C98") & "'!" & .Range("D98")
   .Range("S_6").Formula = "='[" & .Range("B100").Offset(5, 0) & "]" & .Range("C98") & "'!" & .Range("D98")
   .Range("S_7").Formula = "='[" & .Range("B100").Offset(6, 0) & "]" & .Range("C98") & "'!" & .Range("D98")
   .Range("S_8").Formula = "='[" & .Range("B100").Offset(7, 0) & "]" & .Range("C98") & "'!" & .Range("D98")
End With

Dann sollte man On Error Resume Next grundsätzlich nur in Ausnahmefällen verwenden und nur so lange, wie es wirklich notwendig ist. Ein Abschalten der Fehlerbehandlung erschwert das Debuggen erheblich. Wenn man hier prüft, ob ein Dateiname angegeben ist, und man die Zuweisung nur dann ausführt, braucht man keine Fehler zu ignorieren.

Das ständige Zugreifen auf z.B. C98 und D98 kostet relativ viel Rechenzeit. Besser nur 1x in eine Variable einlesen und dann diese verwenden.

Statt Offset(1, 0), Offset(2, 0) etc, auszuschreiben, ist es geschickter dies in eine Schleife zu packen. Dadurch dass deine Namen ebenfalls durchnummeriert sind, ist das recht einfach. Außerdem ist die Angabe des Spaltenoffset überflüssig,

Ebenso sollte man die Events nur abschalten, wenn dies nötig ist. Ähnliches gilt für ScreenUpdating.

In Summe sieht das dann so aus:

Code:

Sub EK_Summen_Formeln()
' KalkSummen Formeln
Dim i As Long
Dim Blatt As String
Dim Zelle As String
Dim Datei As String
With Uebersicht
    Blatt = .Range("C98")
    Zeile = .Range("D98")
    For i = 1 To 8
        Datei = .Range("B100").Offset(i - 1)
        If Datei <> "" Then
            .Range("S_" & i).Formula = "='[" & Datei & "]" & Blatt & "'!" & Zelle
        End If
    Next i
End With
End Sub

Jetzt solltest du nur noch C98, DC98 und B100 vernünftige Namen geben, damit auch nach dem Einfügen/Löschen von Zeilen/Spalten automatisch die richtigen Zellen angesprochen werden.

Bei den anderen Routinen gehst du analog vor.

 

Hallo Dirk,
danke für das Aufzeigen einer weiteren Alternative und deine geopferte Zeit.
Ich habe sie probiert und auch das funktioniert sehr gut.
Hebe es erstmal als ein weiteres Modul in der Datei auf,
wer weiß ob Frau es nochmal braucht.
Da ich mit dem Vorgehen von Helmut's Lösung schon recht weit bin,
werde ich diesen auch weiter verfolgen.
Freudige Grüße Cam

 

Hallo Helmut,

Bei dem Code, der sich auf ein Blatt bezieht habe ich das jetzt so gemacht. Klasse, das ist um Längen kürzer und schicker.
Aber wie mache ich das mit dem With-Block, wenn zwei oder gar mehr Blätter vorkommen ?

Code:

DSM.Range("AO47:AO54").Offset(0, 0).Formula = "='[" & Uebersicht.Range("B100").Offset(0, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"

Na klar, das verstehe ich, habe es umgesetzt. -Danke für die Erklärung

Die Schleife ist ja nochmals ein Schlankmacher, werde schauen wo ich dieses noch nutzen kann.

Events habe ich aus, da mir sonst ewig das Worksheet-Change zwischen hopst und ScreenUpdating hat gefühlt die hälfte an Verarbeitungszeit eingespart. Das schaue ich mir nochmal an. Auch hier Danke fürs schlau machen.

Habe ich verstanden und umgesetzt.

Ich versuche mich daran und werde mich mit Ergebnissen, hoffentlich richtige, melden.

Für deine sehr ausführliche *Gehhilfe* meinen herzlichsten Dank.

Liebe Grüße Cam

 

Hallo Cam,

Das With Bezieht sich immer auf das eigentliche Blatt in welchem du etwas erreichen möchtest.
In deinem genannten Fall wäre es das DSM. Die Bezüge auf andere Blätter must du dann benennen, folglich

Code:

With DSM
    .Range("AO47:AO54").Offset(0, 0).Formula = "='[" & Uebersicht.Range("B100").Offset(0, 0) & "]" & Uebersicht.Range("C98") & "'!I47:I54"
End With

 

Hi,

das ist jetzt aber sehr vereinfacht ausgedrückt. With bezieht sich auf das Objekt, das hinter With steht. Bis zum End With kann man das entsprechende Objekt weg lassen und statt dessen einfach nur den Punkt setzen. Sobald ein Punkt ohne irgendwas davor (aber etwas dahinter) im Code vorkommt, wird automatisch das Objekt davor gesetzt. Das es nur einen Punkt gibt („es kann nur einen geben“, wie es so schön bei Highlander heißt), funktioniert das auch nur mit einem Objekt.

Wieso ich hier ständig Objekt statt Blatt schreibe? Weil dies natürlich nich nur mit Blättern sonder mit beliebigen Objekten (also sozusagen allem, was einen Punkt hinter sich hat) geht.

Wenn du nicht dauern Worksheets("IrgendeinBlatt") schreiben willst, kannst du dieses Blatt einer (kurzen) Variablen zuweisen und diese statt dessen verwenden

Code:

Dim a As Worksheet
Set a = Worksheets("IrgendeinBlatt")
a.Cells(1, 1) = 3.14

 

Hallo Helmut,

dank deiner Hilfe und Hinweise sieht mein obiges *Monster* nun so aus

Code:

Sub EK_Summen_Formeln()
Dim i As Long
Dim Blatt As String
Dim Zelle As String
Dim datei As String
With Uebersicht
    Blatt = .Range("qT_Blatt")
    Zelle = .Range("qT_Zelle_KP")
    For i = 1 To 8
        datei = .Range("PR_1").Offset(i - 1)
        If datei <> "" Then
            .Range("S_" & i).Formula = "='[" & datei & "]" & Blatt & "'!" & Zelle
        End If
    Next i
End With
End Sub

Sub MengenDSMBereiche_Formeln()
Dim i As Long
Dim Blatt As String
Dim Zelle As String
Dim datei As String
Dim ASBereich As String, HSBereich As String
With DSM
    Blatt = Uebersicht.Range("qT_Blatt")
    Zelle = Uebersicht.Range("qT_Zelle_KP")
    ASBereich = "AA11:AA129"
    HSBereich = "AO47:AO54"
    For i = 1 To 8
        datei = Uebersicht.Range("PR_1").Offset(i - 1)
      
        If datei <> "" Then
            .Range("" & ASBereich & "").Offset(0, i - 1).Formula = "='[" & datei & "]" & Blatt & "'!F11" ':F129"
            .Range("" & HSBereich & "").Offset(0, i - 1).Formula = "='[" & datei & "]" & Blatt & "'!I47" ':I54"
        End If
    Next i
End With
End Sub

Sub MengenLspBereiche_Formeln()
Dim i As Long
Dim Blatt As String
Dim Zelle As String
Dim datei As String
Dim LSBereich As String
With Lsp
    Blatt = Uebersicht.Range("qL_Blatt")
    Zelle = Uebersicht.Range("qT_Zelle_KP")
    LSBereich = "R8:R520"
    For i = 1 To 8
        datei = Uebersicht.Range("PR_1").Offset(i - 1)
      
        If datei <> "" Then
            .Range("" & LSBereich & "").Offset(0, i - 1).Formula = "='[" & datei & "]" & Blatt & "'!A8" ':A520"
        End If
    Next i
End With
End Sub

Ich habe den drei Bereichen ASBereich, HSBereich und LSBereich zwar auch Namen gegeben (ASB, HSB und LSB), jedoch ist es mir irgendwie nicht gelungen diese im Code zu übergeben.
Ansonsten funktioniert alles sehr gut.
Merci, für deine Geduld mit mir.

Liebe Grüße Cam

 

Hi,

was heißt denn "irgendwie nicht gelungen diese im Code zu übergeben" genau? Eigentlich sollte es genau so funktionieren wie mit den Bereichen in der ersten Funktion.
Eventuell hängt es auch damit zusammen, wie du die Bereiche in den anderen Funktionen ansprichst. Im Augenblick schreibst du z.B. .Range("" & ASBereich & "") wieso verknüpft du deine String-Variable ASBereich mit je einem Leersten davor und danach? Range will als Argument entweder einen String, der die Zellen genau so beschreibt, wie im (englischen) Excel in normalen Formeln üblich, oder zwei Zellen die die gegenüberliegenden Ecken eines rechteckigen Bereichs darstellen. Also entweder nimmst du deine Variable ASBereich die den Inhalt "AA11:AA129" hat. Das sieht dann so aus: .Range(ASBereich). Oder du nimmst den Bereichsnamen ASB, der dann als String übergeben werden muss: .Range("ASB"). Um dich noch mehr zu verwirren: du kannst der Variablen ASBereich auch den Inhalt "ASB" verpassen und wieder .Range(ASBereich) schreiben um den Bereich ASB anzusprechen.

 

Funktioniert in der direkten Nennung tatsächlich perfekt.
Ich denke da habe ich zu Umständlich gedacht.

Genau das hatte ich vergeblich versucht.

Code:

ASBereich = .Range("ASB")

und diverse andere Konstellationen schreiben entweder "" in ASBereich oder bringen bei Anwendung in der Formel einen Laufzeitfehler 1004 *Methode Range für das Objekt Worksheet ist fehlgeschlagen.

Da die von dir genannte direkte Nennung in der Formel aber korrekt funktioniert,

Code:

.Range("ASB").Offset(0, i - 1).Formula = "='[" & datei & "]" & Blatt & "'!F11" ':F129"

kann ich mir die Zuweisung eh sparen und so werde ich das jetzt auch machen.
Abermals Danke

Grüße Cam