Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

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

Problem mit VLookup


Betrifft: Problem mit VLookup von: Marvin L
Geschrieben am: 01.10.2019 16:53:46

Hallo

Ziel ist es eine große Menge an .pdf Dateien auszulesen und umzubennen.
In jeder pdf ist eine Partnernummer, mit der die Datei benannt werden soll.
Dies funktioniert soweit gut.

Zusätzlich soll mit der ermittelten Partnernummer ein VLookup durchgeführt werden.
Das Ergebnis des VLookup (eine Clusterung) soll im Dateinamen vor der Partnernummer stehen, sodass die Dateien letztendlich sortiert abliegen und individuell zugeordnet werden können.
Probleme macht der VLookup.


Cluster = Application.WorksheetFunction.VLookup(SK, Matrix, 2, False)
Der Ursprüngliche Code kommt von: https://vbanet.blogspot.com/

Diesen habe ich versucht an meine Bedürfnisse anzupassen.

Code ist entsprechend auskommentiert:
 

Option Explicit
' Wenn Word nicht offen ist wird diese Variable auf True
' gesetzt und Word am Ende wieder geschlossen
' War Word schon offen, beleibt es das auch
Dim blnTMP As Boolean
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 20.05.2019
' Purpose   : Aus PDF-Dateien etwas auslesen - Dokumente danach umbenennen
' Note      : Funktioniert erst ab Word 2013!!!!!!!!!!
'--------------------------------------------------------------------------
Public Sub Main()
    ' Dimensionieren der Variablen
    Dim objDocument As Object
    Dim strTrenn() As String
    Dim strDatei As String
    Dim strTMP2 As String
    Dim strTMP1 As String
    Dim strTMP As String
    Dim objFSO As Object
    Dim objDir As Object
    Dim strDir As String
    Dim objApp As Object
    Dim lngCalc As Long
    Dim lngTMP As Long
    Dim lngRef As Long
    
    Dim SK As Variant
    Dim Cluster As Variant
    Dim wksAktiv As Worksheet
    Dim Matrix As Range

    Set wksAktiv = ActiveSheet
    
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        lngCalc = .Calculation
        lngRef = Application.ReferenceStyle
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    ' Der Objektvariablen objFSO das "FilesystemObject" zuweisen
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' Wenn Du einen Ordnerauswahldialog möchtest
    'Set objShell = CreateObject("Shell.Application")
    'Set varDir = objShell.BrowseForFolder(0, "Ordner", &H4000, 17)
    'If varDir Is Nothing Then Set objShell = Nothing: Exit Sub
    'strDir = varDir.Self.Path
    ' Datei im gleichen Ordner wie Auswertungsdateien
    strDir = ThisWorkbook.Path
    'strDir = "C:\Temp\Los\"  ' Fester Pfad
    strDir = IIf(Right(strDir, 1) <> "\", strDir & "\", strDir)
    Set objApp = OffApp("Word")
    ' Word nicht sichtbar
    'Set objApp = OffApp("Word", False)
    If Not objApp Is Nothing Then
        strDatei = Dir$(strDir & "*.pdf", vbDirectory)
        Do While strDatei <> ""
            ' Word- Pdf-Dokument öffnen - ab Word 2013!!!!!
            Set objDocument = objApp.Documents.Open _
                (strDir & strDatei)
            ' Text an Leerzeichen trennen/aufsplitten
            strTrenn = Split(objDocument.Range, " ")
            ' Schleife über das Array von Anfang bis Ende
            For lngTMP = LBound(strTrenn) To UBound(strTrenn)
                ' Wenn das Wort Rechnung gefunden wird...
                If strTrenn(lngTMP) Like "*Partnernumm*" Then
                    ' ... schreibe den nächsten Wert in Variable strTMP
                    strTMP = Trim(strTrenn(lngTMP + 1))
                ' Oder wenn das Wort Kunde gefunden wird...
                ElseIf strTrenn(lngTMP) Like "*Patnernumm*" Then
                    ' ... schreibe den nächsten Wert in Variable strTMP1
                    strTMP1 = Trim(strTrenn(lngTMP + 1))
                ElseIf strTrenn(lngTMP) Like "*Händlernumm*" Then
                 ' ... schreibe den nächsten Wert in Variable strTMP1
                    strTMP2 = Trim(strTrenn(lngTMP + 1))
                End If
            Next lngTMP
            ' Word- Pdf-Dokument ohne speichern schlissen
            objDocument.Close False
            
            'Die Partnernummer einer Variablen (für das VLookup Surchkriterium) zuweisen
                 If strTMP <> "" Then
                     SK = strTMP
                     
                 ElseIf strTMP1 <> "" Then
                     SK = strTMP1
                     
                 ElseIf strTMP2 <> "" Then
                     SK = strTMP2
                 End If
                 
            'Matrix definieren in der ein Cluster zugeordnet wird
            Set Matrix = wksAktiv.Range("C17:D20")
                                   
            wksAktiv.Range("A1").Value = SK
                       
            Cluster = Application.WorksheetFunction.VLookup(SK, Matrix, 2, False)
            
            'Cluster = wksAktiv.Range("A2").Value
            
            ' Datei umbenennen mit Datum und Zeit am Ende
            Name strDir & strDatei As strDir & "Pilot_" & Cluster & "_" & strTMP & strTMP1 &  _
strTMP2 & ".pdf"
            ' Array und Variablen leeren
            Erase strTrenn
            Cluster = ""
            strTMP2 = ""
            strTMP1 = ""
            strTMP = ""
            ' Die nächste Datei nehmen
            strDatei = Dir$()
            Set objDocument = Nothing
            
        Loop
    Else
        MsgBox "Applikation nicht installiert!"
    End If
Fin:
    If Not objApp Is Nothing Then
        If blnTMP = True Then
            objApp.Quit
            blnTMP = False
        End If
    End If
    ' Objektvariablen leeren
    Set objDocument = Nothing
    Set objApp = Nothing
    ' Die Applikation aufwecken
    With Application
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = lngCalc
        Application.ReferenceStyle = lngRef
        .DisplayAlerts = True
        .CutCopyMode = True
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : OffApp
' Author    : Case (Ralf Stolzenburg)
' Date      : 20.05.2019
' Purpose   : Start Applikation...
'--------------------------------------------------------------------------
Private Function OffApp(ByVal strApp As String, _
    Optional blnVisible As Boolean = True) As Object
    Dim objApp As Object
    On Error Resume Next
    Set objApp = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objApp = CreateObject(strApp & ".Application")
            blnTMP = True
            If blnVisible = True Then
                On Error Resume Next
                objApp.Visible = True
                Err.Clear
            End If
    End Select
    On Error GoTo 0
    Set OffApp = objApp
    Set objApp = Nothing
End Function

  

Betrifft: AW: Problem mit VLookup von: onur
Geschrieben am: 01.10.2019 17:23:32

"Probleme macht der VLookup" - diese Aussage ist nix wert, solange du nicht verrätst, was für Probleme (welche Fehlermeldung).
Ausserdem wäre die Datei hilfreich - ohne zu wissen, was in den Zellen steht, bringt der Code nix.


  

Betrifft: AW: Problem mit VLookup von: Marvin L
Geschrieben am: 01.10.2019 18:15:08

Hallo Onur, es geht um den Fehlercode 1004.
Die Datei kann ich aus rechtlichen Gründen nicht hochladen.
Ansich ist die Excel auch leer. Einzig eine Liste mit den ID Nummern und einem Clusterbestandteil für die Benennung sind darin enthalten. Beispiel siehe Screenshot:



Der Inhalt der .pdf Dateien ist ja an und für sich auch nicht relevant.
Das Auslesen der Nummern funktioniert.
Darauf aufbauend funktioniert ebenfalls das Umbenennen der Datei mit "entsprechende Nummer".
Nun sollte noch die Clusterung als Bestandteil der Dateibenennung miteinfließen.
Ziel sollte es sein das eine Datei, dann heißt: "Cluster1_123456" die nächste dann "Cluster2_123457".
Also mit der Partnernummer aus dem Fließtext der pdf und dann dazu noch das Cluster aus der Tabelle.
Leider wird jedoch die Fehlermeldung ausgegeben, sobald der Code zur Zeile VLookup kommt.


  

Betrifft: AW: Problem mit VLookup von: onur
Geschrieben am: 01.10.2019 18:25:15

FEHLERMELDUNG und nicht Fehlercode.


  

Betrifft: AW: Problem mit VLookup von: Luschi
Geschrieben am: 01.10.2019 17:40:47

Hallo Marvin,

hier steckt schon mal 1 Fehler drin:


   ' Oder wenn das Wort Kunde gefunden wird...
   ElseIf strTrenn(lngTMP) Like "*Patnernumm*" Then
      ' ... schreibe den nächsten Wert in Variable strTMP1
      strTMP1 = Trim(strTrenn(lngTMP + 1))
Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Problem mit VLookup von: Marvin L
Geschrieben am: 01.10.2019 17:59:53

Hallo Luschi,

' ... Kunde ... ist soweit irrelevant, da ein Apostroph voransteht, werde ich der Übersicht wegen aber anpassen, danke für den Hinwei :)

"Patnernummer" ist tatsächlich beabsichtigt, da es einige Rechtschreibfehler dieser Art in den auszulesenden Dateien gibt

Für weitere Anregungen bin ich dankbar

LG Marvin


  

Betrifft: AW: Problem mit VLookup von: Daniel
Geschrieben am: 01.10.2019 19:03:35

Hi
probleme dürfte es immer geben, wenn der Suchbegriff SK nicht in der ersten Spalte der Tabelle Matrix vorkommt.

um in diesem Fall den Fehler zu vermeiden, musst du so programmieren:

Cluster = Application.VLookup(SK, Matrix, 2, False)

If IsError(Cluster) then 
    ' hier der Code, wenn SK nicht in Matrix vorkommt
Else
    ' hier der normale Code
End if
dass SK nicht in Matrix gefunden wird, kann mehrere Ursachen haben:
a) der Fall kann tatsächlich vorkommen
b) SK wird falsch zugewiesen
c) Matrix verweist auf die falsche Tabelle
d) die Schreibweisen des Textes in SK und in der Tabelle "Matrix" sind unterschiedlich

Gruß Daniel


  

Betrifft: AW: Problem mit VLookup von: Marvin L
Geschrieben am: 02.10.2019 17:44:10

Hi Daniel,

habe den Fehler gefunden.
Wie du schreibst lag es an "d) die Schreibweisen des Textes in SK und in der Tabelle "Matrix" sind unterschiedlich"

SK als Variant verglichen mit Daten in der Tabelle hat nur #NV produziert.
Habe es jetzt als String und die Tabelle entsprechend formatiert. SK als Integer und Long und die Tabelle als Standard formatiert hat leider nicht funktioniert, warum auch immer.

Danke auch für den Hinweis mit der Prüfschleife!
Diese habe ich noch um 3 weitere mögliche Fehler erweitert.
Das Makro ist stabil durchgelaufen. Vielen Dank für die Hilfe!
Bei Interesse am Code, kann ich diesen noch posten.

LG Marvin


Beiträge aus dem Excel-Forum zum Thema "Problem mit VLookup"

Verschnittproblem mit Solver lösen