Microsoft Excel

Herbers Excel/VBA-Archiv

Hilfe beim ''such Makro''


Betrifft: Hilfe beim ''such Makro'' von: Uwe
Geschrieben am: 01.10.2019 20:21:32

Hallo Leute!

Ich hoffe ihr könnt mir helfen.ich benutze ein Makro aus eurem Archiv und schaffe es einfach nicht die suche in Spalte A auf die ersten 6Zeichen zu begrenzen.
Hab schon an so vielen Stellen Left 6 eingesetzt .Aber ohne Erfolg .
Kann mir bitte jemand helfen?

Das ist das Makro aus Modul1&Modul2:
https://www.herber.de/forum/archiv/1280to1284/1280211_VBA_Datei_suchen_inkl_Unterordner.html

Vielen lieben Dank schon mal!!!!!

  

Betrifft: AW: Hilfe beim ''such Makro'' von: Piet
Geschrieben am: 01.10.2019 23:23:39

Hallo Uwe

ich sehe da mehrere Codex, welchen genau hast du denn genommen, und was was steht in deiner Spalte A im Original, und was willst du abschneiden? Ohne deinen Code ist das schwierig, reines Ratespiel. An welcher Stelle im Code benutzt du Left 6??

mfg Piet


  

Betrifft: AW: Hilfe beim ''such Makro'' von: Uwe
Geschrieben am: 02.10.2019 04:24:28

Hallo Piet

In Spalte A stehen ArtikelCodes , die sind sechsstellig (123456).Die Hälfte in der Spalte A hat aber Größen Beschreibungen (123456-123 oder 123456-123-12) .Auf dem Laufwerk sind nur die ersten 6Zeichen hinterlegt , also bekomme ich für dich keine Hyperlinks .Das würde ich gern ändern.

Genutzt habe ich diesen Code:


kommt als Code in Modul1

Option Explicit

Sub Start() 
Dim strFolder$, ArFileFilter() 
Dim nCount&, lngFileCount& 
Dim ArrayData(), ArrayFile(), sFile$ 
  
strFolder = "G:\VBA" 'Ordner angeben 
 
With Tabelle1 'Tabelle anpassen 
     
   .Range("B2", .Cells(.Rows.Count, 2)).Clear 'Daten Spalte B löschen 
    nCount = .Cells(.Rows.Count, 1).End(xlUp).Row 
    If nCount < 2 Then Exit 
Sub 'keine Daten in Tabelle 
    ArrayData = .Range("A2", .Cells(nCount, 1)) 
    strFolder = IIf(Right$(strFolder, 1) = "\", strFolder, strFolder & "\") 
    For nCount = 1 To Ubound(ArrayData) 
        If ArrayData(nCount, 1) <> "" Then 
            ArFileFilter = Array(ArrayData(nCount, 1) & "*.*") 'Filter für die Suche 
            'Suchen mit Unterordner sonst SubFolder = False 
            FindFiles ArrayFile, strFolder, lngFileCount, ArFileFilter, True 
        End If 
        If lngFileCount > 0 Then 
            'nur erste gefundene Datei Listen 
            sFile = ArrayFile(0) 
            'Hyperlink erstellen 
            ArrayData(nCount, 1) = _
                "=HYPERLINK(""" & sFile & """,""" & Right$(sFile, Len(sFile) - InStrRev(sFile, " _
\")) & """)" 
            lngFileCount = 0 
        Else 
            ArrayData(nCount, 1) = "nix gefuden" 
        End If 
    Next nCount 
 
    .Range("B2").Resize(Ubound(ArrayData), 1).FormulaR1C1 = ArrayData 
 
End With 
Erase ArrayData 
End 
Sub 
 
 
 
  
 
kommt als Code in Modul2
Option Explicit 
'Teile des Originalcode von Nepumuk. *********************************************************** _
 
  
Private Declare 
Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long 
Private Declare 
Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
    ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long 
Private Declare 
Function FindClose Lib "kernel32" ( _
    ByVal hFindFile As Long) As Long 
  
Private Const INVALID_HANDLE_VALUE = -1& 
Private Const MAX_PATH = 260& 
  
Private Type FILETIME 
    dwLowDateTime As Long 
    dwHighDateTime As Long 
End Type 
  
Private Enum FILE_ATTRIBUTE 
    FILE_ATTRIBUTE_READONLY = &H1 
    FILE_ATTRIBUTE_HIDDEN = &H2 
    FILE_ATTRIBUTE_SYSTEM = &H4 
    FILE_ATTRIBUTE_DIRECTORY = &H10 
    FILE_ATTRIBUTE_ARCHIVE = &H20 
    FILE_ATTRIBUTE_NORMAL = &H80 
    FILE_ATTRIBUTE_TEMPORARY = &H100 
End Enum 
  
Private Type WIN32_FIND_DATA 
    dwFileAttributes As Long 
    ftCreationTime As FILETIME 
    ftLastAccessTime As FILETIME 
    ftLastWriteTime As FILETIME 
    nFileSizeHigh As Long 
    nFileSizeLow As Long 
    dwReserved0 As Long 
    dwReserved1 As Long 
    cFileName As String * MAX_PATH 
    cAlternate As String * 14 
End Type 
  
  
Sub FindFiles(ArrayData(), ByVal strFolderPath As String, _
        ByRef lngFileCount As Long, ArFileFilter, Optional SubFolder As Boolean = True) 
    Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String 
      
    lngSearch = FindFirstFile(strFolderPath & "*.*", WFD) 
      
    If lngSearch <> INVALID_HANDLE_VALUE Then 
        GetFilesInFolder ArrayData, strFolderPath, lngFileCount, ArFileFilter 
        Do 
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then 
                strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1) 
                If SubFolder = False Then Exit 
Sub 'ohne Unterordner 
                If (strDirName <> ".") And (strDirName <> "..") Then _
                    FindFiles ArrayData, strFolderPath & strDirName & "\", lngFileCount,  _
ArFileFilter 
            End If 
        Loop While FindNextFile(lngSearch, WFD) 
        FindClose lngSearch 
    End If 
End 
Sub 
  
Sub GetFilesInFolder(ArrayData(), ByVal strFolderPath As String, _
        ByRef lngFileCount As Long, ArFileFilter) 
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strFileName As String 
Dim FileFilter 
  
For Each FileFilter In ArFileFilter 
    lngSearch = FindFirstFile(strFolderPath & FileFilter, WFD) 
    If lngSearch <> INVALID_HANDLE_VALUE Then 
        Do 
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> _
                FILE_ATTRIBUTE_DIRECTORY Then 
                strFileName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1) 
                Redim Preserve ArrayData(lngFileCount) 
                ArrayData(lngFileCount) = strFolderPath & strFileName 'auflisten in Zelle 
                lngFileCount = lngFileCount + 1 
            End If 
        Loop While FindNextFile(lngSearch, WFD) 
        FindClose lngSearch 
    End If 
Next 
End 
Sub 
 

Left 6 habe ich in der Zeile eingesetzt 

Daten in Tabelle 
    ArrayData = .Range("A2", .Cells(nCount, 1))

Nur anscheinend nicht richtig? 
Oder ist das die falsche stelle?
Oder reicht das nicht aus?
Ich weiß nicht weiter .

Danke für die schnelle Antwort! 



  

Betrifft: AW: Hilfe beim ''such Makro'' von: Daniel
Geschrieben am: 02.10.2019 10:55:29

Hi

du liest dir die Daten aus Spalte A ja in ein Array ein.
dann lauf doch direkt danach mit einer Schleife über dieses Array und kürzte alle Werte auf 6 Zeichen.
der Rest des Makros sollte dann normal und ohne weitere Änderung funktionieren:

...
ArrayData = .Range("A2", .Cells(nCount, 1)) 
For i = 1 to Ubound(ArrayData, 1)
    ArrayData(i, 1) = Left(ArrayData(i, 1), 6)
Next
...

Gruß Daniel


  

Betrifft: AW: Hilfe beim ''such Makro'' von: Uwe
Geschrieben am: 02.10.2019 12:01:17

Sub End



Danke!!!Daniel


Hab es ausgetauscht gegen deinen Code
Jetzt kommt der Fehler 'Fehler beim Kompilieren , variable nicht definiert '

Markiert wird das das i bei

For i =1 To Ubound (ArrayData, 1)



Muss ich noch was ändern?


  

Betrifft: wer lesen kann ist im Vorteil von: Daniel
Geschrieben am: 02.10.2019 13:31:19

die Fehlermeldung ist doch eigentlich recht aussagekräftig.
du hast eine der Variablen nicht deklariert.

Gruß Daniel


  

Betrifft: AW: wer lesen kann ist im Vorteil von: Uwe
Geschrieben am: 02.10.2019 17:44:44

Oh!!!!!

Ist das peinlich!!!!

Hab mich über YouTube mal bisschen schlau gemacht .Jetzt komm ich mir richtig blöd vor!Ist das erste mal das ich mit VAB's arbeite oder besser es versuche.
Die variable "i" ist also nicht definiert .
Reicht es wenn ich schreibe :


ArFileFilter = Array(ArrayData(nCount, 1) & "*.*") = i 'Filter für die Suche

Oder muss das schon oben bei den Dim'definiert werden?

Entschuldigt bitte das ich mich so anstelle!!! Und danke für eure Geduld und zeit!!!!

Gruß Uwe


  

Betrifft: AW: wer lesen kann ist im Vorteil von: Daniel
Geschrieben am: 02.10.2019 18:12:15

wenn du eine Variable verwenden willst, musst du dir erstmal überlegen, was für einen Datentyp sie bekommen soll (Zahl, Text, Objektvariable usw) und dann zu Beginn des Makros deklarieren:

Dim i as Long

danach kannst du diese Variable im Code verwenden.
mit der von dir gezeigten Codezeile kann ich nichts anfangen.
die ergibt so für mich keinen Sinn.

Gruß Daniel


  

Betrifft: AW: es werde licht von: Uwe
Geschrieben am: 02.10.2019 20:00:05

Hallo Daniel!

Super!!!

Ich freu mich das ich hier die Chance bekomme etwas dazu zu lernen!!!
Der Datentyp is eine 6stellige zahl.
Also müsste long schon perfekt sein.

Hab meine test Datei mal mit dazu gepackt



https://drive.google.com/file/d/0B48Z6bwiiLchVzNrLWJCWm1Id0lSU0dSX2FtSms0azNJemdR/view?usp=drivesdk


Werd es am Montag gleich ausprobieren .Bin schon so gespannt

Tausend Dank!!!

Gruß Uwe

Ps.:gibt es alle vba-Begriffe mit Definition zum runter laden und ausdrucken?


Beiträge aus dem Excel-Forum zum Thema "Hilfe beim ''such Makro''"