Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Sverweis in Makro umwandeln





Frage

Hallo, ich habe eine relativ komplexe Sverweis-Funktion, die auf Dateien in verschiedenen Ordnern zurückgreift (bisher nur 2 Dateien). Da es aber noch mehr verschiedene Quelldateien werden sollen, und zu allem Überfluss die Quelldateien auch mittels Makro Infos aus meiner aktuellen Datei bezieht, ist meine Funktion überfordert (und ich auch, denn ich habe eigentlich keinen Schimmer von VBA). Hier meine Verweisfunktion: =WENN(UND($A3=101;NICHT(ISTLEER($B3)));SVERWEIS($B3´U:\Büro\100\101\Planung_101.xls´!Planung_101;7;0);WENN(UND($A3=105;NICHT(ISTLEER($B3)));SVERWEIS($B3´U:\Büro\100\105\Planung_105.xls´!Planung_105;7;0)M);"")) Ich suche also jetzt ein Makro, das dieser Funktion entspricht und um weitere Dateien erweiterbar ist und das automatisch beim Start meiner aktuellen Tabelle ausgeführt wird. Zur Info: in Spalte A können die Dateibezeichnungen (101,105) mehrmals vorkommen. In Spalten B&C können die Werte auch mehrmals vorkommen; es sind auch die gleichen Suchkriterien in den unterschiedlichen Dateien vorhanden. Ach ja, und das ganze muss in Excel 97 laufen. Ich hoffe, ich habe mich verständlich ausgedrückt, und mir kann jemand bei meinem Problem helfen!

Antwort 1 von CaroS

Hallo lowlyworm,

mein Excel sagt, die eingegebene Formel enthält Fehler. Bitte überprüfe das. Nachdem man die falschen Apostrophs ´ durch richtige ´ ersetzt hat, scheint mindestens ein Semikolon zu fehlen. Über die Bezeichnungen Planung_101 und Planung_105 kann ich nur vermuten, dass es sich um Namen handelt. Bitte bestätigen/erklären. Ansonsten kommt es beim Kopieren von Formeln aus der Formelzeile in dieses Eingabefenster gelegentlich vor, dass aus Formeln mit & und Semikolon Teile "verschwinden", nämlich das, was zwischen den beiden Zeichen steht. Das kann man verhindern, indem man nach jedem & ein Leerzeichen einfügt und mit Hilfe der Vorschau prüft, ob alles in Ordnung ist.

Ein paar Fragen hätte ich noch. Aus welcher (Ergebnis-)Zelle hast Du die Formel kopiert? Aus der dritten Zeile, aus D3? Excel-Formeln besitzen die wunderbare Eigenschaft, dass sie beim Kopieren und Ziehen in andere Zellen ihre relativen Bezüge anpassen. Diese Anpassungsfähigkeit in einem Makro nachzubilden erfordert einen gewissen Aufwand. Für welche Ergebniszelle(n) willst Du das Makro einsetzen, sind das mehrere?

Gruß,
CaroS

Antwort 2 von lowlyworm

Hallo CaroS,

schön, dass Du schon so schnell geantwortet hast.

Ich habe mir die Formel noch mal angesehen, und der Fehler liegt wohl tatsächlich im Copy + Paste, sprich: & und ; wurden an 2 Stellen verschluckt, wie Du vermutet hast. Ich hoffe, ich habe die Formel jetzt fehlerfrei eingestellt.

WENN(UND($A3=101;NICHT(ISTLEER($B3)));SVERWEIS($B3& $C3;´U:\Büro\100\101\Planung_101.xls´!Planung_101;7;0);WENN(UND($A3=105;NICHT(ISTLEER($B3)));SVERWEIS($B3& $C3;´U:\Büro\100\105\Planung_105.xls´!Planung_105;7;0);""))

Planung_101 und Planung_105 sind sowohl Dateinamen als auch die Bereichsnamen, wobei 101 und 105 sozusagen als Bezeichnung in Spalte A vorkommen (Nach dem Motto: wähle Datei Planung_101 für die Suche, wenn in A3 101 steht. )

Die Ergebniszellen sind E3 und F3, wobei E3 den Spaltenindex 7 hat (wie in der Formel oben) und F3 den Spaltenindex 10.

Ist es vielleicht eine Möglichkeit, für die Bezüge eine Hilfstabelle einzurichten, in der diese dann stehen (damit sie einfach erweitert werden können)?

Schon mal Danke für die Hilfe,

Gruß
lowlyworm

Antwort 3 von CaroS

Hallo lowlyworm,

jetzt ist alles klar. Wenn in A3 die Zahl NNN steht und B3 nicht leer ist, soll

- auf dem Laufwerk U:
- im Pfad \Büro\100
- im Unterverzeichnis \NNN
- in der Datei Planung_NNN.xls
- in einem Bereich mit dem Namen Planung_NNN
- in der äußersten linken (wahrscheinlich unsortierten?) Spalte

- die zusammengesetzte Zeichenkette B3 & C3 (= Suchkriterium) gesucht werden und

- der entsprechende Wert aus der 7. bzw. 10. Spalte (= weiterer Parameter) geholt werden.

Was Excel im Formelbereich relativ "geräuschlos" beim Öffnen einer Datei erledigt, nämlich fragt, ob Vernüpfungen in andere Dateien aktualisiert werden sollen, und das bei ´Ja´ dann auch im Hintergrund erledigt, würde in VBA ein bisschen anders laufen müssen. Man kommt nicht drum herum, die Datei, aus der der Wert geholt werden soll, per VBA richtig zu öffnen, mit allem was dazu gehört. Das kann natürlich unproblematisch sein, muss es aber nicht, und wird insgesamt nicht so still und leise möglich sein wie die Aktualisierung von Formeln. Größe und Inhalt der anderen Dateien sowie Vorgänge beim Öffnen dieser Dateien können sich dabei auswirken. (Z. B. könnten diese ebenfalls den Bedarf haben, ihre Verknüpfungen zu aktualisieren, um nur mal ein Beispiel zu nennen.)

Ok, mal sehen, wie weit ich komme. (Wahrscheinlich sind die richtigen VBA-Experten am Ende doch wieder schneller, aber das macht ja nichts.)

Gruß,
CaroS

Antwort 4 von lowlyworm

Hallo CaroS,

genau so ist der Sachverhalt (inkl. unsortierter äußerster linker Spalte).

Das Öffnen im Hintergrund der Quelldateien sollte nicht so problematisch sein, weil alle Aktualisierungen dort über einen Makro-Click laufen und die Aktualisierungen nur einmal pro Woche gemacht werden.

Wäre Spitze, wenn Du eine Lösung findest!

Gruß
lowlyworm

Antwort 5 von CaroS

Hallo lowlyworm,

ich habe hier was zum Testen. Da ich leider vergessen habe, Dich nach dem - hoffentlich ebenfalls einheitlichen - Tabellennamen Deiner Suchdateien (U:\...) zu fragen, bin ich noch etwas unsicherer, ob es funktionieren wird.

Du muss auf jeden Fall im oberen Teil (bis zum letzten Rem ---------) alle Angaben richtig ausfüllen bzw. überprüfen. Dazu Alt + F11 drücken, erst links unter dem Dateinamen auf Diese Arbeitsmappe (oder auf die richtige Tabelle) klicken, dann den gesamten Code in den rechten freien Bereich kopieren. Nun anpassen, speichern und mit Alt + F11 zurück zu Excel. Über Extras -- Makro -- Makros... Ausführen starten.

Option Explicit

Sub SVERWEISE()
Dim Datei_offen() As Boolean, NNN_min As Integer, NNN_max As Integer, Sindex() As Integer
Dim Ergeb() As String
Dim anz As Integer, v As Integer, z As Integer, z_min As Integer, z_max As Integer
Dim diese_mappe As String, diese_tabelle As String
Dim pfad As String, datei As String, tabelle As String, bereich As String
Dim sNNN As String, sBC As String, suche As Range, sspalte As Range, szeile As Integer

Rem wie viele SVERWEISE = wie viele Ergebnisse?
anz = 2
ReDim Preserve Ergeb(1 To anz)
ReDim Preserve Sindex(1 To anz)
Rem -------------------------------------------
Rem Spaltenindex und Ergebnisspalte für SVERWEIS
Sindex(1) = 7: Ergeb(1) = "E"
Sindex(2) = 10: Ergeb(2) = "F"
Rem Sindex(3) = ?: Ergeb(3) = "?" usw.
Rem -------------------------------------------
Rem Angaben zu dieser Datei (Ergebnisdatei)
diese_mappe = ActiveWorkbook.Name
Rem unsicher: diese_tabelle = ActiveSheet.Name
Rem deshalb besser den Tabellennamen angeben
diese_tabelle = "Tabelle1"
Rem -------------------------------------------
Rem Beginn ab Zeile
z_min = 3
Rem -------------------------------------------
Rem Angaben zu den Suchdateien
pfad = "U:\Büro\100\105\"
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
Rem einheitliche Namensbestandteile für Datei-
Rem namen, Tabellennamen (wichtig!), Bereichsnamen
datei = "Planung_"
tabelle = "Planung_"
bereich = "Planung_"
Rem -------------------------------------------
Rem Nummernbereich (kann großzügig angegeben werden)
NNN_min = 100
NNN_max = 199
Rem -------------------------------------------

ReDim Preserve Datei_offen(NNN_min To NNN_max)
ActiveWorkbook.Sheets(diese_tabelle).Activate
z_max = ActiveSheet.Range("A65536").End(xlUp).Row

For z = z_min To z_max
    For v = 1 To anz
        Workbooks(diese_mappe).Activate
        ActiveWorkbook.Sheets(diese_tabelle).Activate
        If ActiveSheet.Range("B" & CStr(z)) <> "" Then
            sNNN = ActiveSheet.Range("A" & CStr(z))
            sBC = ActiveSheet.Range("B" & CStr(z)) & ActiveSheet.Range("C" & CStr(z))
            If Not Datei_offen(CInt(sNNN)) Then
                Workbooks.Open pfad & datei & sNNN & ".xls", 3, True
                Datei_offen(CInt(sNNN)) = True
            Else
                Workbooks(datei & sNNN & ".xls").Activate
            End If
            ActiveWorkbook.Sheets(tabelle & sNNN).Activate
            MsgBox ActiveWorkbook.Path & "\" & ActiveWorkbook.Name, , ActiveSheet.Name
            Set sspalte = ActiveSheet.Range(bereich & sNNN).Columns(1)
            MsgBox sspalte.Address, , "Suche nach " & sBC
            Set suche = ActiveSheet.Range(bereich & sNNN).Columns(1).Find(sBC, LookIn:=xlValues)
            If Not suche Is Nothing Then
                szeile = suche.Row
                Workbooks(diese_mappe).Sheets(diese_tabelle).Cells(z, Range(Ergeb(v) & "1").Column) = _
                ActiveSheet.Cells(szeile, sspalte.Column + Sindex(v) - 1)
            End If
        End If
    Next v
Next z
End Sub


Und wie bereits angedeutet, zusätzlich auch den Tabellennamen angeben, der Bereichsname allein genügt nicht. Es ist alles vorbereitet, ich hoffe, dass es auch einigermaßen verständlich ist. Viel Glück beim Probieren!

Gruß,
CaroS

Antwort 6 von lowlyworm

Hallo CaroS!

Bin leider erst heute wieder an meinen Rechner gekommen, habe Dein Makro aber sofort ausprobiert, und es klappt!!!

Vielen, vielen Dank!!!

Ich habe nur eine kleine Änderung eingebaut, nämlich den Pfad noch dynamisch gemacht (weil der auch abhängig von NNN ist.)

Sub SVERWEISE()
Dim Datei_offen() As Boolean, NNN_min As Integer, NNN_max As Integer, Sindex() As Integer
Dim Ergeb() As String
Dim anz As Integer, v As Integer, z As Integer, z_min As Integer, z_max As Integer
Dim diese_mappe As String, diese_tabelle As String
Dim pfad As String, datei As String, tabelle As String, bereich As String
Dim sNNN As String, sBC As String, suche As Range, sspalte As Range, szeile As Integer

Rem wie viele SVERWEISE = wie viele Ergebnisse?
anz = 2
ReDim Preserve Ergeb(1 To anz)
ReDim Preserve Sindex(1 To anz)
Rem -------------------------------------------
Rem Spaltenindex und Ergebnisspalte für SVERWEIS
Sindex(1) = 7: Ergeb(1) = "E"
Sindex(2) = 10: Ergeb(2) = "F"
Rem Sindex(3) = ?: Ergeb(3) = "?" usw.
Rem -------------------------------------------
Rem Angaben zu dieser Datei (Ergebnisdatei)
diese_mappe = ActiveWorkbook.Name
Rem unsicher: diese_tabelle = ActiveSheet.Name
Rem deshalb besser den Tabellennamen angeben
diese_tabelle = "Tabelle1"
Rem -------------------------------------------
Rem Beginn ab Zeile
z_min = 3
Rem -------------------------------------------

Rem Nummernbereich (kann großzügig angegeben werden)
NNN_min = 100
NNN_max = 199
Rem -------------------------------------------

ReDim Preserve Datei_offen(NNN_min To NNN_max)
ActiveWorkbook.Sheets(diese_tabelle).Activate
z_max = ActiveSheet.Range("A65536").End(xlUp).Row

For z = z_min To z_max
For v = 1 To anz
Workbooks(diese_mappe).Activate
ActiveWorkbook.Sheets(diese_tabelle).Activate
If ActiveSheet.Range("B" & CStr(z)) <> "" Then
sNNN = ActiveSheet.Range("A" & CStr(z))
sBC = ActiveSheet.Range("B" & CStr(z)) & ActiveSheet.Range("C" & CStr(z))

Rem Angaben zu den Suchdateien
pfad = "U:\Büro\"& Left(sNNN, 1) & "00\"& sNNN & "\"
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
Rem einheitliche Namensbestandteile für Datei-
Rem namen, Tabellennamen (wichtig!), Bereichsnamen
datei = "Planung_"
tabelle = "Planung_"
bereich = "Planung_"
Rem ------------------------------------------

If Not Datei_offen(CInt(sNNN)) Then
Workbooks.Open pfad & datei & sNNN & ".xls", 3, True
Datei_offen(CInt(sNNN)) = True
Else
Workbooks(datei & sNNN & ".xls").Activate
End If
ActiveWorkbook.Sheets(tabelle & sNNN).Activate
MsgBox ActiveWorkbook.Path & "\" & ActiveWorkbook.Name, , ActiveSheet.Name
Set sspalte = ActiveSheet.Range(bereich & sNNN).Columns(1)
MsgBox sspalte.Address, , "Suche nach " & sBC
Set suche = ActiveSheet.Range(bereich & sNNN).Columns(1).Find(sBC, LookIn:=xlValues)
If Not suche Is Nothing Then
szeile = suche.Row
Workbooks(diese_mappe).Sheets(diese_tabelle).Cells(z, Range(Ergeb(v) & "1").Column) = _
ActiveSheet.Cells(szeile, sspalte.Column + Sindex(v) - 1)
End If
End If
Next v
Next z
End Sub

Bleibt mir nur noch eine Frage: Wie baue ich noch ein, dass sich die Dateien wieder schließen, die sich extra für dieses Makro geöffnet haben?

Nochmal 1000-Dank für die schnelle und kompetente Hilfe!!!

Gruß

lowlyworm

Antwort 7 von CaroS

Hallo lowlyworm,

bin auch gerade erst zurück. Was in dem Makro noch fehlt, ist das Schließen der Excel-Mappen auf dem Laufwerk U:. Wenn Du das gebrauchen kannst, würde ich es schnell noch schreiben.

Gruß,
CaroS

Antwort 8 von CaroS

Hallo lowlyworm,

ich habe das Schließen der Suchdateien eingefügt und das Anpassen des Pfades so verändert, dass alle Angaben zum Makro "oben" und nicht in der Schleife gemacht werden.

Dabei ist mir aufgefallen, dass man das Makro noch einmal anpassen müsste, wenn die Nummern nicht dreistellig sind oder wenn es (als Text formatierte) Nummern mit führenden Nullen gibt (004), die in Spalte A stehen.

Option Explicit

Sub SVERWEISE()
Dim Datei_offen() As Boolean, NNN_min As Integer, NNN_max As Integer, Sindex() As Integer
Dim Ergeb() As String
Dim anz As Integer, v As Integer, z As Integer, z_min As Integer, z_max As Integer
Dim diese_mappe As String, diese_tabelle As String
Dim pfad As String, datei As String, tabelle As String, bereich As String
Dim sNNN As String, sBC As String, suche As Range, sspalte As Range, szeile As Integer

Rem wie viele SVERWEISE = wie viele Ergebnisse?
anz = 2
ReDim Preserve Ergeb(1 To anz)
ReDim Preserve Sindex(1 To anz)
Rem -------------------------------------------
Rem Spaltenindex und Ergebnisspalte für SVERWEIS
Sindex(1) = 7: Ergeb(1) = "E"
Sindex(2) = 10: Ergeb(2) = "F"
Rem Sindex(3) = ?: Ergeb(3) = "?" usw.
Rem -------------------------------------------
Rem Angaben zu dieser Datei (Ergebnisdatei)
diese_mappe = ActiveWorkbook.Name
Rem unsicher: diese_tabelle = ActiveSheet.Name
Rem deshalb besser den Tabellennamen angeben
diese_tabelle = "Tabelle1"
Rem -------------------------------------------
Rem Beginn ab Zeile
z_min = 3
Rem -------------------------------------------
Rem Angaben zu den Suchdateien
pfad = "U:\Büro\"
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
Rem einheitliche Namensbestandteile für Datei-
Rem namen, Tabellennamen, Bereichsnamen
datei = "Planung_"
tabelle = "Planung_"
bereich = "Planung_"
Rem -------------------------------------------
Rem Nummernbereich (kann großzügig angegeben werden)
NNN_min = 100
NNN_max = 199
Rem -------------------------------------------

ReDim Preserve Datei_offen(NNN_min To NNN_max)
ActiveWorkbook.Sheets(diese_tabelle).Activate
z_max = ActiveSheet.Range("A65536").End(xlUp).Row

For z = z_min To z_max
    For v = 1 To anz
        Workbooks(diese_mappe).Activate
        ActiveWorkbook.Sheets(diese_tabelle).Activate
        If ActiveSheet.Range("B" & CStr(z)) <> "" Then
            sNNN = ActiveSheet.Range("A" & CStr(z))
            pfad = pfad & Left(sNNN, 1) & "00\" & sNNN & "\"
            sBC = ActiveSheet.Range("B" & CStr(z)) & ActiveSheet.Range("C" & CStr(z))
            If Not Datei_offen(CInt(sNNN)) Then
                Workbooks.Open pfad & datei & sNNN & ".xls", 3, True
                Datei_offen(CInt(sNNN)) = True
            Else
                Workbooks(datei & sNNN & ".xls").Activate
            End If
            ActiveWorkbook.Sheets(tabelle & sNNN).Activate
            MsgBox ActiveWorkbook.Path & "\" & ActiveWorkbook.Name, , ActiveSheet.Name
            Set sspalte = ActiveSheet.Range(bereich & sNNN).Columns(1)
            MsgBox sspalte.Address, , "Suche nach " & sBC
            Set suche = ActiveSheet.Range(bereich & sNNN).Columns(1).Find(sBC, LookIn:=xlValues)
            If Not suche Is Nothing Then
                szeile = suche.Row
                Workbooks(diese_mappe).Sheets(diese_tabelle).Cells(z, Range(Ergeb(v) & "1").Column) = _
                ActiveSheet.Cells(szeile, sspalte.Column + Sindex(v) - 1)
            End If
        End If
    Next v
Next z
Rem geöffnete Dateien schließen
Application.DisplayAlerts = False
For z = NNN_min To NNN_max
    If Datei_offen(z) Then
        Rem Workbooks(pfad & datei & Right("00" & CStr(z), 3) & ".xls").Close SaveChanges:=False
        Workbooks(datei & CStr(z) & ".xls").Close SaveChanges:=False
    End If
Next z
Application.DisplayAlerts = True
End Sub


Gruß,
CaroS

Antwort 9 von lowlyworm

Hallo nochmal,

klappt wieder einwandfrei!

Die Zahlen bleiben 3-stellig; falls sich das noch ändert, werde ich sie einfach entsprechend umdefinieren. (Wenn ich´s hinkriege...)

Aber natürlich sind mir jetzt ein paar Mankos aufgefallen, an die ich vorher nicht gedacht habe:

- Es kann vorkommen, dass eine Nummer in Spalte A eingetragen wird, zu der es kein Dokument Planung_NNN gibt. In dem Fall soll eine MsgBox zur Info kommen (Text: Nummer nicht vorgesehen)

- Es kann auch vorkommen, dass die Suchkriterien nicht in der Kombination in der Quelltabelle vorkommen. Dann soll ebenfalls eine MsgBox erscheinen (Text: Bitte melden)

- wenn jetzt das Makro über meine Tabelle läuft, werden alle bereits bestehenden Daten ersetzt bzw. überarbeitet. Kann man es so einrichten, dass nur dort neue Daten in die Spalten E + F eingefügt werden, wo noch keine Daten vorhanden sind? (Damit die alten Angaben zur Info erhalten bleiben) [Suche die erste Zeile, in der in Spalte E nichts steht und beginne erst dort mit dem eigentlichen Makro]

So, ich hoffe, mir fällt nicht noch mehr auf ...

Dankeschön nochmal!

Gruß

lowlyworm

Antwort 10 von CaroS

Hallo lowlyworm,

mit Deinen Fragen 1 und 2 kommst Du auf das leidige (aber leider auch notwendige) Thema Fehlerbehandlung. Ich weiß nicht, wann ich dazu komme, vor morgen abend wird es jedenfalls nichts.

Hinzu kommt, dass das Makro durch die Messageboxen plötzlich "interaktiv" würde. D. h. es läuft nicht mehr im Hintergrund durch - fehlerfreie Daten vorausgesetzt, sondern stoppt bei jeder Messagebox und setzt die Arbeit erst nach Beantwortung der Messagebox fort.

Der dritte Punkt kommt mir - als außenstehender Person - ziemlich willkürlich vor. Wenn die vorhandenen Werte in Spalte E oder F und die Werte, der per Abfrage/SVERWEIS geholt werden, gleich sind, dann spielt es - außer aus Gründen der Laufzeit / Performance des Makros - keine Rolle, ob man sie überschreibt oder sich die Aktion spart. Im anderen Fall könnte man aber einen womöglich "schlechteren" Wert in Spalte E oder F durch eine "besseren" Wert aus einer Suchdatei ersetzen und tut es nicht, und das ganz ohne Kommentar.

Wer kann hinterher beurteilen, wie "gut" oder "schlecht" die Daten insgesamt sind, wie oft "bessere" Werte nicht genutzt wurden, nur weil bereits "schlechtere" Werte da waren?

Bitte versteh mich richtig, ich kenne Deine Daten nicht und sie gehen mich auch nichts an, aber nach diesem Prinzip hat ein einmal vorhandener Wert, egal wie "gut" oder "schlecht" er ist, automatisch immer und in alle Ewigkeit Vorrang vor einem möglicherweise "besseren" Wert. Und niemand bemerkt es so richtig.

Gruß,
CaroS

Antwort 11 von lowlyworm

Hallo CaroS,

die Problematik in meiner Tabelle besteht darin, dass sie auch von anderen Personen verwendet wird, d.h. ich habe bei der Eintragung selbst keinen Einfluss darauf, ob nur "richtige" Nummern benutzt werden, oder auch "falsche" eingesetzt werden. Aber das kann ich für die erste Frage auch einfach über eine Gültigkeitsbeschränkung festlegen.

Im zweiten Fall wird bei einer falschen Eintragung das Makro aber auch abgebrochen, deswegen scheint es für mich sinnvoller, dies über eine MsgBox direkt einzubauen. (Hier ist eine Gültigkeitsbeschränkung nicht möglich).

Was meine 3. Frage angeht: Die Eintragungen in meine Tabelle erfolgen auf wöchentlicher Basis, und deswegen sind die älteren Daten grundsätzlich als "historisch" anzusehen und müssen nicht mehr aktualisiert werden. Und mein Grundgedanke für diese Frage hängt tatsächlich mit der Performance zusammen, weil die Quelldateien nicht auf einem lokalen Server zur Verfügung stehen, sondern von unterschiedlichen Standorten zusammengetragen werden müssen. Bei meinen Tests bisher hat der Durchlauf des Makros für 2 Zeilen schon lange gedauert; "in Echt" werden wohl in jeder Woche ca. 5 Zeilen neu hinzukommen. Wenn dann die "historischen" Daten auch noch neu berechnet werden, dauert es meiner Einschätzung nach wirklich zu lange. Noch dazu kommt, dass die Abfrageparameter sich wiederholen werden. Dh. ich kann in der Kalenderwoche 25 und in KW 26 jeweils die NNN 105 mit den Suchparametern 17 (aus Spalte B) und MA (aus Spalte C) haben. Wenn ich dann in KW 26 das Makro laufen lasse, aktualisiert es in beiden Zeilen, obwohl es reicht, wenn in der neuen Zeile die aktuellen Werte aus meiner Quelle angegeben werden (Die "besseren" Werte stehen also dadurch dann zur verfügung).

Ich hoffe, ich habe mich einigermaßen verständlich ausgedrückt,aber vor allem hoffe ich, dass Dir klar ist, wie weit Du mir schon mit dem Makro, so wie es jetzt ist, geholfen hast! Und ich kann halt auch überhaupt nicht einschätzen, wie aufwendig diese Änderung ist..

Gruß
lowlyworm

Antwort 12 von CaroS

Hallo lowlyworm,

damit die Performance nicht weiter runter geht als unbedingt nötig, hatte ich es von vornherein so gemacht, dass jede Suchdatei, die benötigt wird, nur einmal geöffnet wird, bis zum Ende des Makros offen bleibt und erst dann wieder geschlossen wird.

If Not Datei_offen(CInt(sNNN)) Then
    Workbooks.Open pfad & datei & sNNN & ".xls", 3, True 
    Datei_offen(CInt(sNNN)) = True
Else
    Workbooks(datei & sNNN & ".xls").Activate
End If


Es spielt also keine Rolle, ob und wann noch weitere NNN = 105 o. a. auftauchen, jeder weitere Zugriff kostet praktisch nichts. (Selbst wenn bei sehr großen Suchdateien eine Auslagerung des Hauptspeichers nötig sein sollte, kostet das nur Bruchteile von dem, was ein Schließen und neues Öffnen kosten würde.)

Die Gültigkeitsbeschränkungen sollte man, wo sie möglich sind, unbedingt einbauen, sie lassen sich gegenüber den Anwendern eigentlich auch ganz gut "verkaufen".

In der Frage der Messageboxen hast Du natürlich grundsätzlich völlig recht. Wenn es Fehler in den Daten geben sollte, ist eine Messagebox und eine kontrollierte Fortsetzung in jedem Falle besser als ein unbehandelter Fehler mit anschließendem Abbruch. Mit
On Error Resume Next
würde man im Hintergrund sowieso nicht durchkommen.

Leider können sich - zumindest aus der Sicht der Programmierung - eine ganze Menge verschiedene Fehler ereignen (Pfad\Dateiname falsch, Datei kann nicht geöffnet werden, Tabellenname falsch, Bereichsname falsch, Suchwert nicht vorhanden), auf die man unterschiedlich reagieren müsste. Dazu muss man sie aber erstmal erkennen und unterscheiden, und das kriege ich kurzfristig leider nicht aus dem Ärmel geschüttelt. (Andere vielleicht schon, es braucht sich hier niemand zurückhalten!)

Sobald ich was habe, melde ich mich.
Gruß, CaroS

Antwort 13 von lowlyworm

Hallo nochmal,

hab´s mal mitgestoppt: Wenn man das Makro über Excel aufruft, dauert es bei 40 Zeilen bereits 4 Minuten, bis es vollständig ausgeführt ist. Wenn man es nur im VBA-Editor laufen lässt, geht es bedeutend schneller (Weil nicht immer in die Quelldateien umgesprungen wird).

Was die Fehler angeht, hast Du Recht, die können überall auftauchen. Nur liegt die Richtigkeit des Pfads usw. in meinen eigenen Händen, nur die Suchwerte (bzw. nicht vorhandenen Suchwerte) werden auch durch Andere eingegeben. Deswegen ist die Fehlerwahrscheinlichkeit dort höher.

Diese Punkte nur als Anmerkung nebenbei. Ich freue mich aber, dass Du noch "am Ball" bist.

Gruß
lowlyworm

Antwort 14 von CaroS

Hallo lowlyworm,

ich bin mir zwar ziemlich sicher, dass da irgendwo noch ein Fehler drin ist, aber ich finde jetzt nichts mehr. Du kannst es ja mal ausprobieren.

Im Gegensatz zu mir, mir fehlen nämlich die echten Testdaten und es ist ziemlich mühsam, sich alle guten und alle Fehler-Fälle erst zurechtzubasteln. Meistens gehe ich Kompromisse ein, weil ich kein Lw U: besitze und auch die gesamte Vezeichnisstruktur nicht erst herstellen will, ändere den Code ein wenig ab, aber selbst beim Fertigmachen für Dich kann man wieder neue Fehler einschleppen.

Teste das am besten mal und sag bescheid, ob/was noch nicht in Ordnung ist. Für die Wahl, ob mit oder ohne Überschreiben der E- und F-Werte, hast Du im oberen Teil eine weitere Variable, die Du True oder False setzen kannst.

Gruß,
CaroS
__________________________________________

Bitte beide Teile zusammenkopieren!
__________________________________________

Option Explicit

Sub SVERWEISE()
Dim Datei_offen() As Boolean, NNN_min As Integer, NNN_max As Integer, Sindex() As Integer
Dim Ergeb() As String, ergeb_leer As Boolean, überschreiben As Boolean
Dim anz As Integer, v As Integer, z As Integer, z_min As Integer, z_max As Integer
Dim diese_mappe As String, diese_tabelle As String
Dim pfad As String, pfadNNN As String, datei As String, tabelle As String, bereich As String
Dim sNNN As String, sBC As String, suche As Range, sspalte As Range, szeile As Integer

Rem wie viele SVERWEISE = wie viele Ergebnisse?
anz = 2
ReDim Preserve Ergeb(1 To anz)
ReDim Preserve Sindex(1 To anz)
Rem -------------------------------------------
Rem Spaltenindex und Ergebnisspalte für SVERWEIS
Sindex(1) = 7: Ergeb(1) = "E"
Sindex(2) = 10: Ergeb(2) = "F"
Rem Sindex(3) = ?: Ergeb(3) = "?" usw.
Rem -------------------------------------------
Rem Überschreiben vorhandener Ergebniswerte
Rem ja: = True / nein: = False
überschreiben = False
Rem -------------------------------------------
Rem Angaben zu dieser Datei (Ergebnisdatei)
diese_mappe = ActiveWorkbook.Name
Rem unsicher: diese_tabelle = ActiveSheet.Name
Rem deshalb besser den Tabellennamen angeben
diese_tabelle = "Tabelle1"
Rem -------------------------------------------
Rem Beginn ab Zeile
z_min = 3
Rem -------------------------------------------
Rem Angaben zu den Suchdateien
pfad = "U:\Büro\"
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
Rem einheitliche Namensbestandteile für Datei-
Rem namen, Tabellennamen, Bereichsnamen
datei = "Planung_"
tabelle = "Planung_"
bereich = "Planung_"
Rem -------------------------------------------
Rem Nummernbereich (kann großzügig angegeben werden)
NNN_min = 100
NNN_max = 199
Rem -------------------------------------------

Antwort 15 von CaroS

__________________________________________

Damit ich das nicht in 3 Teile teilen muss, fange ich nochmal von vorn an. Hier also Teil 1:
__________________________________________

Option Explicit 

Sub SVERWEISE() 
Dim Datei_offen() As Boolean, NNN_min As Integer, NNN_max As Integer, Sindex() As Integer 
Dim Ergeb() As String, ergeb_leer As Boolean, überschreiben As Boolean 
Dim anz As Integer, v As Integer, z As Integer, z_min As Integer, z_max As Integer 
Dim diese_mappe As String, diese_tabelle As String 
Dim pfad As String, pfadNNN As String, datei As String, tabelle As String, bereich As String 
Dim sNNN As String, sBC As String, suche As Range, sspalte As Range, szeile As Integer 

Rem wie viele SVERWEISE = wie viele Ergebnisse? 
anz = 2 
ReDim Preserve Ergeb(1 To anz) 
ReDim Preserve Sindex(1 To anz) 
Rem ------------------------------------------- 
Rem Spaltenindex und Ergebnisspalte für SVERWEIS 
Sindex(1) = 7: Ergeb(1) = "E" 
Sindex(2) = 10: Ergeb(2) = "F" 
Rem Sindex(3) = ?: Ergeb(3) = "?" usw. 
Rem ------------------------------------------- 
Rem Überschreiben vorhandener Ergebniswerte 
Rem ja: = True / nein: = False 
überschreiben = False 
Rem ------------------------------------------- 
Rem Angaben zu dieser Datei (Ergebnisdatei) 
diese_mappe = ActiveWorkbook.Name 
Rem unsicher: diese_tabelle = ActiveSheet.Name 
Rem deshalb besser den Tabellennamen angeben 
diese_tabelle = "Tabelle1" 
Rem ------------------------------------------- 
Rem Beginn ab Zeile 
z_min = 3 
Rem ------------------------------------------- 
Rem Angaben zu den Suchdateien 
pfad = "U:\Büro\" 
If Right(pfad, 1) <> "\" Then pfad = pfad & "\" 
Rem einheitliche Namensbestandteile für Datei- 
Rem namen, Tabellennamen, Bereichsnamen 
datei = "Planung_" 
tabelle = "Planung_" 
bereich = "Planung_" 
Rem ------------------------------------------- 
Rem Nummernbereich (kann großzügig angegeben werden) 
NNN_min = 100 
NNN_max = 199 
Rem ------------------------------------------- 

On Error Resume Next
Application.ScreenUpdating = False

ReDim Preserve Datei_offen(NNN_min To NNN_max)
ActiveWorkbook.Sheets(diese_tabelle).Activate
z_max = ActiveSheet.Range("A65536").End(xlUp).Row

For z = z_min To z_max
    ergeb_leer = False
    For v = 1 To anz
        If Workbooks(diese_mappe).Sheets(diese_tabelle).Cells(z, Range(Ergeb(v) & "1").Column) = "" Then
            ergeb_leer = True
            Exit For
        End If
    Next v
    Workbooks(diese_mappe).Activate
    ActiveWorkbook.Sheets(diese_tabelle).Activate
    Rem 2 Bedingungen: B <> "" UND (Ergebniszelle = "" ODER überschreiben)


Antwort 16 von CaroS

__________________________________________

Und hier Teil 2:
__________________________________________


    If (ActiveSheet.Range("B" & CStr(z)) <> "") And (ergeb_leer Or überschreiben) Then
        sNNN = ActiveSheet.Range("A" & CStr(z))
        pfadNNN = pfad & Left(sNNN, 1) & "00\" & sNNN & "\"
        sBC = ActiveSheet.Range("B" & CStr(z)) & ActiveSheet.Range("C" & CStr(z))
        If Not Datei_offen(CInt(sNNN)) Then
            Workbooks.Open pfadNNN & datei & sNNN & ".xls", 3, True
            If Err.Number = 1004 Then
                MsgBox "Zelle A" & CStr(z) & " enthält den Wert ´" & sNNN & "´." & Chr(13) & Chr(13) & _
                "Fehler: Die Datei ´" & pfad & datei & sNNN & ".xls´ konnte nicht gefunden werden. " & _
                Chr(13) & Chr(13) & "Wahrscheinliche Ursache: " & Chr(13) & "  In ´" & pfad & _
                "´ gibt es keine " & "Unterverzeichnisse mit den Namen ´" & Left(sNNN, 1) & "00\" & _
                sNNN & "\´ " & Chr(13) & "  oder es " & "gibt dort keine Datei mit dem Namen ´" & _
                datei & sNNN & ".xls´." & Chr(13) & Chr(13) & "Die Verarbeitung wird mit dem nächsten " & _
                "Wert fortgesetzt.", , "Fehler ´" & Err.Number & "´ bei Workbooks.Open"
            ElseIf Err.Number <> 0 Then
                MsgBox "Beim Öffnen der Datei ´" & datei & sNNN & ".xls´ ist folgender Fehler aufgetreten: " _
                & Chr(13) & Chr(13) & "´" & Err.Number & "´: " & Error() & Chr(13) & Chr(13) & _
                "Der Wert ´" & sNNN & "´ aus Zelle A" & CStr(z) & " kann nicht verarbeitet werden, " & _
                "es wird aber " & Chr(13) & "versucht, die Verarbeitung mit dem nächsten Wert fortzusetzen.", , _
                "Fehler ´" & Err.Number & "´ bei Workbooks.Open"
            End If
            Datei_offen(CInt(sNNN)) = True
        Else
            Workbooks(datei & sNNN & ".xls").Activate
            If Err.Number = 9 Then
                MsgBox "Die bereits geöffnete Datei ´" & datei & sNNN & ".xls´ konnte nicht aktiviert " & _
                "werden. " & Chr(13) & "Deshalb kann der Wert ´" & sNNN & "´ aus Zelle A" & CStr(z) & _
                " nicht verarbeitet werden." & Chr(13) & Chr(13) & "Die Verarbeitung wird mit dem nächsten " & _
                "Wert fortgesetzt.", , "Fehler ´" & Err.Number & "´ bei Workbooks.Activate"
            ElseIf Err.Number <> 0 Then
                MsgBox "Beim Aktivieren der bereits geöffneten Datei ´" & datei & sNNN & ".xls´ ist " & _
                "folgender Fehler aufgetreten: " & Chr(13) & Chr(13) & "´" & Err.Number & "´: " & Error() & _
                Chr(13) & Chr(13) & "Der Wert ´" & sNNN & "´ aus Zelle A" & CStr(z) & " kann nicht " & _
                "verarbeitet werden, es wird aber " & Chr(13) & "versucht, die Verarbeitung mit dem " & _
                "nächsten Wert fortzusetzen.", , "Fehler ´" & Err.Number & "´ bei Workbooks.Activate"
            End If
        End If
        If Err.Number <> 0 Then
            Datei_offen(CInt(sNNN)) = False
            Err.Clear
        Else
            ActiveWorkbook.Sheets(tabelle & sNNN).Activate
            Rem MsgBox ActiveWorkbook.Path & "\" & ActiveWorkbook.Name, , ActiveSheet.Name
            Set sspalte = ActiveSheet.Range(bereich & sNNN).Columns(1)
            Rem MsgBox sspalte.Address, , "Suche nach " & sBC
            Set suche = ActiveSheet.Range(bereich & sNNN).Columns(1).Find(sBC, LookIn:=xlValues)
            If Not suche Is Nothing Then
                szeile = suche.Row


Antwort 17 von CaroS

__________________________________________

Aus irgendeinem Grund sind es nun doch 3 Teile geworden. Hier also Teil 3:
__________________________________________

     If überschreiben Then
                    For v = 1 To anz
                        Workbooks(diese_mappe).Sheets(diese_tabelle).Cells(z, _
                        Range(Ergeb(v) & "1").Column) = ActiveSheet.Cells(szeile, _
                        sspalte.Column + Sindex(v) - 1)
                    Next v
                Else
                    For v = 1 To anz
                        If Workbooks(diese_mappe).Sheets(diese_tabelle).Cells(z, _
                        Range(Ergeb(v) & "1").Column) = "" Then
                            Workbooks(diese_mappe).Sheets(diese_tabelle).Cells(z, _
                            Range(Ergeb(v) & "1").Column) = ActiveSheet.Cells(szeile, _
                            sspalte.Column + Sindex(v) - 1)
                        End If
                    Next v
                End If
            End If
        End If
    End If
Next z

Rem geöffnete Dateien schließen
Application.DisplayAlerts = False
For z = NNN_min To NNN_max
    If Datei_offen(z) Then
        Rem sNNN = Right("00" & CStr(z), 3)
        Rem Workbooks(pfad & datei & Right("00" & CStr(z), 3) & ".xls").Close SaveChanges:=False
        Workbooks(datei & CStr(z) & ".xls").Close SaveChanges:=False
    End If
Next z

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Antwort 18 von CaroS

Hallo lowlyworm,

Du kanst Dir hier eine leicht überarbeitete Variante mit Benachrichtigung, falls der Suchbegriff nicht gefunden wurde (fehlte bisher) herunterladen. Das ist weniger fehleranfällig als das Zusammenkopieren mehrerer Stücken.

http://www.netupload.de/detail.php?img=562be24ee611cc1854a4801091f1...

Gruß,
CaroS

Antwort 19 von lowlyworm

Hallo CaroS!

Wow, ich bin extrem beeindruckt. Es funktioniert grandios. Ich hätte das in 100 Jahren nicht hinbekommen! Perfekt!!!!

1000-Dank!!!!

Gruß
lowlyworm

Antwort 20 von CaroS

Hallo lowlyworm,

ich sag auch danke für die Rückmeldung. CaroS