Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

VBA Wert suchen in ext. Wks

Betrifft: VBA Wert suchen in ext. Wks von: Bastian
Geschrieben am: 25.10.2020 06:26:51

---- Position eines Wertes aus einer geschlossenen Arbeitsmappe auslesen und in einer Formel verwenden ----

Hallo Zusammen,

Ich benötige eure Hilfe zu einem Datenerfassungstool das ich mir zusammengebastelt habe und es mir ermöglicht Zeiten (hh:mm) aus sehr vielen geschlossenen Dateien auszulesen. Die gesuchten Werte stehen IMMER in den selben Spalten aber in immer unterschiedlichen Zeilen.
Um das Vorweg zu nehmen, nein ich kann die Datenstruktur der zu lesenden Dateien leider nicht beeinflussen und nein, die Dateien händisch aufzumachen ist leider auch keine Option. Ich bin aber, aufgrund meiner Recherchen, optimistisch, dass es auch so geht. Die Frage ist nur wie?

Ich habe selbst ein wenig versucht und bin auf diverse Lösungsansätze gestoßen, im Einzelnen alles Bruchstücke die meinen Anforderungen entsprechen (zum Beispiel das Aufrufen geschlossener Dateien, oder das Suchen eines bestimmten Wertes mit Rückgabe der Zeilenposition, etc.)
https://www.herber.de/mailing/Vorkommen_eines_Wortes_in_Arbeitsmappen_eines_Verzeichnisse.htm
https://www.herber.de/forum/archiv/1136to1140/1138051_Per_VBA_suchen_Ergebniszeile_ausgeben.html
.....etc.

Leider bin ich in VBA aber nicht Firm genug um diese zu einem Funktionierenden Stück Code zusammenzusetzen, hier hoffe ich auf eure Hilfe/Expertise.

Das Auslesen der einzelnen Zeiten (immer in Spalte G) geschieht über die SVERWEIS Funktion, die Pfade und Dateinamen werden mit einem separaten Makro ausgelesen und in der SpalteA aufgelistet, beginnend ab Zeile 3. Es gibt jeweils zwei Suchkriterien, diese Stehen ab SpalteB (bis XX) in den Zeilen1 und 2.
Jedes Suchkriterium für sich kann bereits über die SVERWEIS Funktion abgerufen werden, das funktioniert. Also wenn ein Wert in Zeile eins, suche in Zieldatei in SpalteA, wenn wert in Zeile2, suche in Zieldatei in Spalte B, soweit so gut. (Auch wenn ich es schöner fände wenn die Entscheidung welche Formel zum Zuge kommt bereits im Modul fallen würde und nur die anzuwendende Formel in die Zelle geschrieben wird, das bekomme ich mit viel rumprobieren aber vermutlich auch alleine hin)

        Range(Cells(LRow, 2), Cells(LRow, LCol)).Formula = _
        "=IF(B$2="""",VLOOKUP(B$1 & ""*"",'" & sPath & _
        "[" & sFile & "]" & sWks & "'!$A1:I9999,7,0), VLOOKUP(B$2 & ""*"",'" & _
        sPath & "[" & sFile & "]" & sWks & "'!$B1:I9999,6,0))"
Nun wäre die Aufgabenstellung den Suchbereich für den Wert aus Zeile2 in Abhängigkeit von dem Ergebnis aus einer Abfrage in Zeile1 zu machen (wenn dort etwas drinsteht).

Als Beispiel:
	A			B		C		D
1				Maschine1	Maschine2	Maschine3
2				Zeit1		Zeit1
3	C:Test\Test.xls		00:00		00:00		00:00
Jetzt wird hoffentlich auch klar wöfür ich die Abhängikeit benötige, sagen wir in der Test.xls steht der Wert "Maschine1" in A376 und "Zeit1" in B377 und "Maschine2" in A690 und "Zeit1" in B691

Hier würde mit meiner aktuellen Abfrage bei Maschine2 die Zeit von Maschine1 stehen, deshalb würde ich gerne zuerst nach der Position von "Maschine2" suchen und diese dann als Startwert für die Matrixabfrage nach Zeit1 nehmen.

B3 = SVERWEIS(B2;'C:\Test\[Test.xls]Tabelle1'!$B376:I9999;6;0)
C3 = SVERWEIS(C2;'C:\Test\[Test.xls]Tabelle1'!$B690:I9999;6;0)
D3 = SVERWEIS(D1;'C:\Test\[Test.xls]Tabelle1'!$A1:I9999;7;0)

Ich hoffe ich habe mich halbwegs verständlich ausgedrückt, kann, wenn nötig auch gerne eine Beispieldatei präparieren (das Original ist natürlich ein wenig komplexer und arbeitet mit anderen Zellbezügen)

Bin gespannt auf euren Input
Danke

Betrifft: AW: VBA Wert suchen in ext. Wks
von: Hajo_Zi
Geschrieben am: 25.10.2020 07:34:40

in einer geschlossnner Datei kannstz Du nicht suchen.

GrußformelHomepage

Betrifft: AW: VBA Wert suchen in ext. Wks
von: Bastian
Geschrieben am: 25.10.2020 07:57:57

Hallo,
danke fürs Feedback.
Vllt habe ich mich missverständlich ausgedrückt, deswegen auch der zweite Thread mit dem Wortlaut „händisch“ öffnen. Prinzipiell kann ich mit den Dateien machen was ich will, ich habe nur keine Lust jede einzelne von Hand zu öffnen. Sollte das die Software übernehmen habe ich damit überhaupt kein Problem. Nur wenn dazu externe Software benötigt wird siehts wieder schwierig aus, es müsste mit Excel alleine gehen - sorry wenn ich hier für Verwirrung gesorgt habe/sorge

Betrifft: AW: VBA Wert suchen in ext. Wks
von: Hajo_Zi
Geschrieben am: 25.10.2020 08:23:51

zu dem vorhandenen Code.

Zu Deiner Datei kann ich nichts schreiben, was wohl daran liegt das ich nicht auf fremde Rechner schaue.Ich baue keine Datei nach.

Sollte die Datei verlinkt werden?

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
http://www.ms-office-forum.de/forum/showthread.php?t=322895
änderrn.

Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

http://www.excel-ist-sexy.de/bilder-statt-datei/

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Das ist nur meine Meinung zu dem Thema.

Gruß Hajo

Betrifft: AW: VBA Wert suchen in ext. Wks
von: Bastian
Geschrieben am: 25.10.2020 09:38:15

Hallo Hajo,

hatte ja geschrieben, dass ich gerne bereit bin eine einfache Beispieldatei hochzuladen, logisch.

Auswertetool:
https://www.herber.de/bbs/user/141063.xlsm

Beispielquelle:
https://www.herber.de/bbs/user/141064.xls

Schonmal Danke für deine/eure Hilfe!!!

Betrifft: AW: VBA Wert suchen in ext. Wks
von: Hajo_Zi
Geschrieben am: 25.10.2020 10:12:57

keine Ahnung welche Zelen Du kopieren willst das konnte ich im Code nicht sehen.
For Each objDatei In objDateienliste
    If Not objDatei Is Nothing And Right(LCase(objDatei.Name), 4) = ".xls" Then
        Workbooks.Open ThisWorkbook.Path & "\" & objDatei
Gruß Hajo

Betrifft: AW: VBA Wert suchen in ext. Wks
von: Bastian
Geschrieben am: 25.10.2020 10:58:49

Hallo Hajo,

die Formeln werden in dem Modul ReadDat gebildet und in die Zellen geschrieben. In dieser Schleife wird in jeder Spalte (ab G) in der in Zeile2 oder Zeile3 ein Wert steht eine Formel in die entsprechende Zeile geschrieben bis alle gefundenen Dateien abgearbeitet sind. dann geht es in die nächste Spalte bis alle Spalten abgearbeitet sind.

In dieser Schleife müsste ich ja zuerst bestimmen welchen Vorgang ich für diese Spalte hernehmen will (Nur Wert in Zeile 2, Nur Wert in Zeile3 oder Wert in Zeile2+3 und je nach dem was hier rauskommt dann weitermachen. Diese Abfrage habe ich aktuell über die Wenn funktion gelöst.
        Range(Cells(LRow, 7), Cells(LRow, LCol)).Formula = _
        "=IF(G$3="""",VLOOKUP(G$2 & ""*"",'" & sPath & _
        "[" & sFile & "]" & sWks & "'!$A1:I9999,7,0), VLOOKUP(G$3 & ""*"",'" & _
        sPath & "[" & sFile & "]" & sWks & "'!$B1:I9999,6,0))"

Wobei das ja nur Fall 1 (Wert in Z2) und Fall 2 (Wert in Z3) abdeckt. Für den Fall 3 fehlen mir die Kenntnisse wie hier der code aussehen müsste, da ich ja dann zuerst in die Dateien reinschauen müsste, die Zeile bestimmen, auf eine Variable übertragen und dann in meinen SVERWEIS einbauen.

Also Quasi

Wenn
Fall1 -> SVERWEIS (Z2;Datei;A1:I9999;7;0)
ODER
Fall2 -> SVERWEIS (Z3;Datei;B1:I9999;6;0)
Ansonsten
Suche Zeile für Z2 in A:A und bilde SVERWEIS (Z3;Datei;Bgefundene position:I9999;6;0)

Gruß
Bastian

Betrifft: AW: VBA Wert suchen in ext. Wks
von: Hajo_Zi
Geschrieben am: 25.10.2020 11:08:01

Hallo Bastian,

Gut ich habe für deen Papierkorb gearbeitet.
Ich bin dann raus.
Es wird schon seinen Grund gehabt haben, das Du nicht mitgeteilt hast um welches Makro es geht. Ich habe wohl das falschew ausgesucht.
Viel Erfolg noch.

Gruß Hajo

Betrifft: AW: VBA Wert suchen in ext. Wks
von: Bastian
Geschrieben am: 25.10.2020 11:32:02

Hallo Hajo,

das tut mir leid wenn du für den Papierkorb gearbeitet hast, das war ganz sicher nicht meine Intention, noch ferner läge es mir dich mit Absicht auf eine falsche Fährte zu führen. Wie und wieso sollte ich das tun?!?

Aus dem Grund habe ich meinem ersten Post einen Auszug aus der Formel aus dem ReadDat Makro an mein im Text dargestelltes Beispiel angepasst und mit Info (das Original ist natürlich ein wenig komplexer und arbeitet mit anderen Zellbezügen) dazugepackt.

Danach habe ich dir die komplette Mappe als Beispiel zur Verfügung gestellt in der auf den ersten Blick ersichtlich ist dass es hier definitiv nicht mehr um SpalteA und Zeile1 und 2 geht.

Nichts desto trotz Danke für deine Hilfe, da hätte einmal mehr nachfragen vielleicht nicht geschadet ich denke an mangelnder Info meinerseits hat es nicht gelegen, wohl eher zu viel und somit zu unübersichtlich...

Betrifft: Übersetzung
von: ChrisL
Geschrieben am: 25.10.2020 07:38:59

SVERWEIS mit mehreren Suchkriterien auf geschlossene Mappe
https://www.herber.de/forum/messages/1788357.html

Falls man die Datei öffnen dürfte, könnte man auf deinen Links/Lösungsansätzen aufbauen, aber mit geschlossener Mappe als Voraussetzung fällt mir leider (ausser PQ) nichts ein.

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 25.10.2020 07:48:12

Hallo,
danke fürs Feedback.
Vllt habe ich mich missverständlich ausgedrückt, deswegen auch der zweite Thread mit dem Wortlaut „händisch“ öffnen. Prinzipiell kann ich mit den Dateien machen was ich will, ich habe nur keine Lust jede einzelne von Hand zu öffnen. Sollte das die Software übernehmen habe ich damit überhaupt kein Problem. Nur wenn dazu externe Software benötigt wird siehts wieder schwierig aus, es müsste mit Excel alleine gehen - sorry wenn ich hier für Verwirrung gesorgt habe/sorge

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 25.10.2020 07:48:14

Hallo,
danke fürs Feedback.
Vllt habe ich mich missverständlich ausgedrückt, deswegen auch der zweite Thread mit dem Wortlaut „händisch“ öffnen. Prinzipiell kann ich mit den Dateien machen was ich will, ich habe nur keine Lust jede einzelne von Hand zu öffnen. Sollte das die Software übernehmen habe ich damit überhaupt kein Problem. Nur wenn dazu externe Software benötigt wird siehts wieder schwierig aus, es müsste mit Excel alleine gehen - sorry wenn ich hier für Verwirrung gesorgt habe/sorge

Betrifft: AW: Übersetzung
von: ChrisL
Geschrieben am: 25.10.2020 09:03:39

Hi Bastian

Im Link wird die Datei geöffnet etc.
https://www.herber.de/mailing/Vorkommen_eines_Wortes_in_Arbeitsmappen_eines_Verzeichnisse.htm

Anstelle von ZÄHLENWENN resp. WorksheetFuntion.CountIf, könnte man SUMMEWENNS resp. WorksheetFunction.SumIfs nehmen.

cu
Chris

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 25.10.2020 11:49:14

Hallo Chris,

danke für die Info. Das muss ich mir in Ruhe anschauen, aber Rückmeldung folgt definitiv.
Bitte lies dir auch kurz meinen Gesprächsverlauf mit Hajo durch solltest du mir weitere Hilfestellung geben, nicht dass dich das selbe Schicksal ereilt!
Danke!

Gruß
Bastian

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 26.10.2020 06:58:33

Hallo Chris,

SUMMEWENNS hilft mir nicht, da ich ja die Zeilennummer brauche. Aber mit VERGLEICH geht es. Auch aus einer anderen Datei heraus, habe ich ausprobiert. Danke für den Wink (mit dem Vorschlaghammer)!

Ich habe jetzt mal versucht mein ReadDat Makro so anzupassen wie ich glaube, dass es aussehen müsste, allerdings bin ich mir nicht sicher ob ich die ganzen variable Spalten und Zeilenbezüge richtig verwendet habe. Das Makro läuft zwar durch, aber es macht was es will....oder zumindest nicht das was ich erwarten würde...

Könntest du mir mal einen Hinweis geben wo ich Anfangen sollte zu suchen, bzw. meine gröbsten Schnitzer aufzeigen? Das wäre wirklich hilfreich, ich habe mir die halbe Nacht un die Ohren geschlagen und am Ende einen Wundertüte bekommen....
Sub ReadDat()

    Dim sPath, sFile, sWks As String
    Dim LRow, LRowFind, LRowRes, LCol, LCol2, LCol3 As Long

    With Worksheets(1)
    LCol2 = .Cells(2, Columns.Count).End(xlToLeft).Column
    LCol3 = .Cells(3, Columns.Count).End(xlToLeft).Column
    LCol = WorksheetFunction.Max(LCol2, LCol3)
    End With

    For LRow = 4 To Cells(Rows.Count, 2).End(xlUp).Row

    sPath = Range("A" & LRow).Value
    sFile = Range("C" & LRow).Value
    sWks = "BatchReport"
   
    If Dir(sPath & sFile) = "" Then
        Beep
        MsgBox "Quelldatei " & sPath & sFile & _
        " wurde nicht gefunden!"
        Exit Sub
    End If

        Range("D" & LRow).Formula = _
        "=VLOOKUP(E3 & ""*"",'" & sPath & _
        "[" & sFile & "]" & sWks & "'!E1:I9999,2,0)"
    
        Range("E" & LRow).Formula = _
        "=LEFT(RC[-1],SEARCH(""["",RC[-1],1)-2)"
        
        Range("F" & LRow).Value = "Time:"
         
    If Cells(LRow, LCol2).Value <> "" And _
        Cells(LRow, LCol3).Value = "" Then
        Range(Cells(LRow, 7), Cells(LRow, LCol)).Formula = _
            "=VLOOKUP(G$2 & ""*"",'" & sPath & _
            "[" & sFile & "]" & sWks & "'!$A1:I9999,7,0)"
            
    ElseIf Cells(LRow, LCol2).Value = "" And _
        Cells(LRow, LCol3).Value <> "" Then
        Range(Cells(LRow, 7), Cells(LRow, LCol)).Formula = _
            "=VLOOKUP(G$3 & ""*"",'" & sPath & _
            "[" & sFile & "]" & sWks & "'!$B1:I9999,6,0)"
            
    Else: Workbooks.Open sPath & sFile, False
        With ThisWorkbook.Worksheets(1)
        LRowFind = .Cells(LRow, LCol2).Value
        LRowRes = WorksheetFunction.Match(LRowFind, Columns(1))
        End With
      ActiveWorkbook.Close savechanges:=False
      Range(Cells(LRow, 7), Cells(LRow, LCol)).Formula = _
            "=VLOOKUP(G$3 & ""*"",'" & sPath & _
            "[" & sFile & "]" & sWks & "'!$B" & LRowRes & ":I9999,6,0)"
    End If
         
    Next LRow

End Sub


Betrifft: AW: Übersetzung
von: ChrisL
Geschrieben am: 26.10.2020 07:56:25

Hi Bastian

Der 3. Parameter von VERGLEICH/Match fehlt.

cu
Chris

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 26.10.2020 11:02:10

ok hast recht, allerdings liefert der VERGLEICH (zumindest in Excel) auch ohne drittes Argument ein Ergebnis, nur eben kein so differenziertes...

Ich hatte eigentlich mehr an grundlegende/strukturelle Fehler gedacht? Kann die Schleife so überhaupt funktionieren? Ist meine Wenn, dann Abfrage vernünftig aufgebaut?

Ich will ja keine Lösung auf dem Silbertablett, ich will es ja selber machen bzw. aus den gemachten Fehlern lernen, aber weiter wie bis dahin bin ich selbst nach einer Nachtschicht intensiven googelns nicht gekommen und werde ich ohne Input vermutlich auch nicht...

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 26.10.2020 11:02:10

ok hast recht, allerdings liefert der VERGLEICH (zumindest in Excel) auch ohne drittes Argument ein Ergebnis, nur eben kein so differenziertes...

Ich hatte eigentlich mehr an grundlegende/strukturelle Fehler gedacht? Kann die Schleife so überhaupt funktionieren? Ist meine Wenn, dann Abfrage vernünftig aufgebaut?

Ich will ja keine Lösung auf dem Silbertablett, ich will es ja selber machen bzw. aus den gemachten Fehlern lernen, aber weiter wie bis dahin bin ich selbst nach einer Nachtschicht intensiven googelns nicht gekommen und werde ich ohne Input vermutlich auch nicht...

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 26.10.2020 11:02:10

ok hast recht, allerdings liefert der VERGLEICH (zumindest in Excel) auch ohne drittes Argument ein Ergebnis, nur eben kein so differenziertes...

Ich hatte eigentlich mehr an grundlegende/strukturelle Fehler gedacht? Kann die Schleife so überhaupt funktionieren? Ist meine Wenn, dann Abfrage vernünftig aufgebaut?

Ich will ja keine Lösung auf dem Silbertablett, ich will es ja selber machen bzw. aus den gemachten Fehlern lernen, aber weiter wie bis dahin bin ich selbst nach einer Nachtschicht intensiven googelns nicht gekommen und werde ich ohne Input vermutlich auch nicht...

Betrifft: AW: Übersetzung
von: ChrisL
Geschrieben am: 26.10.2020 13:56:13

Evtl. so....
Sub ReadDat()
Dim sPath As String, sFile As String, sWks As String
Dim oWkb As Workbook, oWks As Worksheet
Dim LCol As Long, LMaxCol As Long
Dim LRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With ThisWorkbook.Worksheets(1)
    LMaxCol = WorksheetFunction.Max(.Cells(2, Columns.Count).End(xlToLeft).Column, _
                .Cells(3, Columns.Count).End(xlToLeft).Column)

    For LRow = 4 To .Cells(Rows.Count, 2).End(xlUp).Row
        
        sPath = .Cells(LRow, 1).Value
        If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
        sFile = .Cells(LRow, 3).Value
        sWks = "BatchReport"
        
        If Dir(sPath & sFile) = "" Then
            MsgBox "Quelldatei " & sPath & sFile & " wurde nicht gefunden!"
            Exit Sub
        End If
        
        Set oWkb = Workbooks.Open(sPath & sFile)
        Set oWks = oWkb.Worksheets(sWks)
        
For LCol = 5 To LMaxCol
   If .Cells(3, LCol) = "" Then
       .Cells(LRow, LCol) = WorksheetFunction.VLookup(.Cells(2, LCol), oWks.Range("A:G"), 7, 0)
   ElseIf .Cells(2, LCol) = "" Then
       .Cells(LRow, LCol) = WorksheetFunction.VLookup(.Cells(3, LCol), oWks.Range("B:G"), 6, 0)
   Else
       .Cells(LRow, LCol) = WorksheetFunction.VLookup(.Cells(3, LCol), oWks.Range("B" & _
       Application.Match(.Cells(2, LCol), oWks.Columns(1), 0) & ":G" & Rows.Count), 6, 0)
   End If
Next LCol

        oWkb.Close False
    Next LRow
End With
Application.Calculation = xlCalculationAutomatic
End Sub
cu
Chris

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 27.10.2020 07:58:49

Hallo Chris,

vielen Dank für deine Antwort, ich habe es mir mal angeschaut und versucht deine Änderungen (wenn man hier überhaupt noch von Änderungen sprechen kann, ist ja quasi ein neues Makro) nachzuvollziehen
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dient der Performance, habe ich verstanden wieso. Was ich nicht verstanden habe wieso du das ScreenUpdating nicht zurücksetzt, wird das an anderer Stelle erledigt?

Dass es eine Schleife in der Schleife braucht um alle Spalten und alle Zeilen zu versorgen hatte ich mir bereits gedacht bzw. erscheint absolut logisch, aber nicht den Hauch einer Ahnung wo ich ansetzen muss, Danke!!

Meine Quelldateien enthalten ach Makros, diese möchte ich natürlich nicht ausführen, dies habe ich mit
Application.AutomationSecurity = msoAutomationSecurityForceDisable
Application.AutomationSecurity = msoAutomationSecurityByUI
getan, ist das korrekt?

Positioniert habe ich es vor dem öffnen der Quelldatei, so wird es zwar mit jeder Datei neu gesetzt, sollte aber mal ein Pfad nicht passen und das Makro wird vorzeitig verlassen bleibt es wenigstens nicht gesetzt. Oder wie/wo würde man das normalerweise tun?
Sub ReadDat()
Dim sPath As String, sFile As String, sWks As String
Dim oWkb As Workbook, oWks As Worksheet
Dim LCol As Long, LMaxCol As Long
Dim LRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With ThisWorkbook.Worksheets(1)
    LMaxCol = WorksheetFunction.Max(.Cells(2, Columns.Count).End(xlToLeft).Column, _
                .Cells(3, Columns.Count).End(xlToLeft).Column)

    For LRow = 4 To .Cells(Rows.Count, 2).End(xlUp).Row
        
        sPath = .Cells(LRow, 1).Value
        If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
        sFile = .Cells(LRow, 3).Value
        sWks = "BatchReport"
        
        If Dir(sPath & sFile) = "" Then
            MsgBox "Quelldatei " & sPath & sFile & " wurde nicht gefunden!"
            Exit Sub
        End If

Application.AutomationSecurity = msoAutomationSecurityForceDisable

        Set oWkb = Workbooks.Open(sPath & sFile)
        Set oWks = oWkb.Worksheets(sWks)
       
For LCol = 7 To LMaxCol

   If .Cells(3, LCol) = "" Then
       .Cells(LRow, LCol) = WorksheetFunction.VLookup(.Cells(2, LCol) & "*", oWks.Range("A:G"),  _
7, 0)
   ElseIf .Cells(2, LCol) = "" Then
       .Cells(LRow, LCol) = WorksheetFunction.VLookup(.Cells(3, LCol) & "*", oWks.Range("B:G"),  _
6, 0)
   Else
       .Cells(LRow, LCol) = WorksheetFunction.VLookup(.Cells(3, LCol) & "*", oWks.Range("B" & _
       Application.Match(.Cells(2, LCol) & "*", oWks.Columns(1), 0) & ":G" & Rows.Count), 6, 0)
   End If
Next LCol

        oWkb.Close False
    Next LRow
End With
Application.Calculation = xlCalculationAutomatic
Application.AutomationSecurity = msoAutomationSecurityByUI
End Sub
Eine Frage quält mich noch:
Da du ja oben Wert auf maximale Performance legst würde mich noch interessieren wieso du selbst bei den ersten beiden Abfragen in der Quelldatei Arbeitest. An dieser Stelle würde der "feste" SVERWEIS als Formel ja funktionieren, der ja bedeutend schneller berechnet wird.
Hat das rein optische Gründe, dass man bei sowas bei einer Methode bleibt? Bei 17 Dateien und 5 Abfragen rattert der SVERWEIS in 2sek durch während die Abfrage in der Datei 9sek dauert.

Versteh mich nicht falsch, ich finde deine Lösung sowohl technisch als auch optisch wirklich sehr sehr ansprechend, ich würde nur gerne wissen wieso der Profi es so macht, wie er es macht.

Tausend Dank schonmal für deine Geduld mit mir!!!

Betrifft: AW: Übersetzung
von: ChrisL
Geschrieben am: 27.10.2020 10:21:37

Hi

ScreenUpdating setzt sich von alleine zurück.

An der Security solltest du nichts ändern. Hierfür gibts
Application.EnableEvents = False
(im Gegensatz zu ScreenUpdating wichtig, dass du es wieder auf True stellst)
Einsetzen würde ich es am gleichen Ort wie ScreenUpdating/Calculation

Über das Performance-Thema kann man diskutieren. Ich bin davon ausgegangen, dass die Wahrscheinlichkeit gross ist, dass die Datei sowieso geöffnet werden muss, weshalb ich gleich alles mit der identischen Methode erledigt habe. Auch wenn die Datei bei der Formel-Variante nicht sichtbar geöffnet wird, muss Excel ja trotzdem darauf zugreifen d.h. geöffnet wird sowieso.

Der grosse Performance-Unterschied erstaunt mich. Vielleicht hilft EnableEvents und sonst nimmst du halt doch besser die Formeln.

cu
Chris

Betrifft: AW: Übersetzung
von: Bastian
Geschrieben am: 28.10.2020 03:26:40

Hi Chris,

danke für die Antwort.
EnableEvents löst das Problem mit den Makros nicht, sobald die erste Quelldatei aufgemacht wird bekomme ich eine Sicherheitswarnung ob ich Makros aktivieren oder deaktivieren will . An der Performance konnte ich auch keine Verbesserung feststellen, kann es aber trotzdem erst einmal drin lassen, schadet ja sicher nicht!?!
Hast du eine andere Idee was man mit den Makros noch probieren kann, wenn ich google (und das habe ich ja vorher auch schon) kommt nur die Automation Security als Lösungsvorschlag...

Ich hatte im ersten Anlauf ja noch zwei Formeln drin die einen String auslesen und dann über eine Hilfsspalte kürzen, das habe ich jetzt auch mal in deinem Stil versucht, die Hilfsspalte konnte ich auch los werden in dem ich den String auf eine Variable schreibe und diese dann kürze, würde das auch ohne Variable in einem Abwasch gehen?
sRName = WorksheetFunction.VLookup(.Cells(3, "D") & "*", _
        oWks.Range("E:I"), 2, 0)
        .Cells(LRow, "D") = Left(sRName, InStr(sRName, "[") - 2)
Wiedereinmal vielen Dank für deine Hilfe

Betrifft: AW: Übersetzung
von: ChrisL
Geschrieben am: 28.10.2020 08:15:04

Hi Bastian

OK, ich dachte es ginge nur um die Events, das habe ich falsch verstanden. Somit wäre dein Lösungsansatz richtig. Besser wäre es, wenn die Dateien auf einem sicheren Pfad liegen würden, so dass gar keine Meldung zur Makrosicherheit erscheint. Es wäre interessant, testweise die Dateien auf einen sicheren Pfad zu verlagern und die Performance zu messen. Selber habe ich wenig Erfahrung mit dem Thema, aber ich könnte mir vorstellen, dass die Makrosicherheit den Prozess bremst.

Theoretisch wie folgt, aber da der SVERWEIS hiermit zweimal ausgeführt werden muss, würde ich ebenfalls eine Variable verwenden.
.Cells(LRow, "D") = Left(WorksheetFunction.VLookup(.Cells(3, "D") & "*", oWks.Range("E:I"), 2, 0), InStr(WorksheetFunction.VLookup(.Cells(3, "D") & "*", oWks.Range("E:I"), 2, 0), "[") - 2)

cu
Chris

Beiträge aus dem Excel-Forum zum Thema "VBA Wert suchen in ext. Wks "