Wie kann ich ein ARRAY mit "drei" Spalten schnell nach einem Wert durch suchen?
Zuzeit wird es Zeile für Zeile (mit einer FOR NEXT Schleife) durchsucht, dies dauert aber sehr lange.
Gruß und Dank an alle
Dietmar
Wie kann ich ein ARRAY mit "drei" Spalten schnell nach einem Wert durch suchen?
Zuzeit wird es Zeile für Zeile (mit einer FOR NEXT Schleife) durchsucht, dies dauert aber sehr lange.
Gruß und Dank an alle
Dietmar
grundsätzlich merkt man keinen Unterschied, ob es jetzt ne gezählte, ne Kopf- oder ne Fußgesteuerte Schleife is.
Poste mal den Code, dann wird sich zeigen, ob man was dran optimieren kann.
Grüßli
For w = 1 To 500
If Array(2, w) = "Irgendwas" Then
MsgBox "An " & w & " .Stelle gefunden"
Exit For
Next w
Ich würde gern folgenden Code gern verwenden, aber dieser scheint nur bei einem einspaltingem ARRAY zufunktionieren
Sub Durchsuchen()
Dim arrBereich As Variant
Dim intRow As Integer
arrBereich = Range("A1:A16")
On Error Resume Next
intRow = Application.Match("Irgendwas", arrBereich, 0)
If Err > 0 Then
MsgBox "Nicht gefunden"
Else
MsgBox "An " & intRow & " .Stelle gefunden"
End If
End Sub
Gruß Dietmar
Das wird nicht schneller gehen, es sei denn, du sortierst die Tabelle in einer Form, das du an je nach Suchwert den Bereich der durchforstet wird einschränkst.
Ansonsten seh ich keine Möglichkeit.
Gruß Dietmar
PS fals ich noch was finde werde ich es hier posten.
Gruß Dietmar
dein Code habe ich probiert er funktioniert im Sheet gut aber wenn ich ihn bei einem ARRAY anwende, kommt ein Laufzeit Fehler (424) in der Zeile "Set zellen = .FIND ...."
Gruß Dietmar
Gruß Dietmar
Gruß Dietmar
Sub TestCreateFile()
Dim iFile As Integer, iCounter As Integer
Dim sFileA As String 'für WGT ARRAY
Dim sFileB As String
Dim sFile As String, sTxt As String
Dim WGTOK As Boolean
XLSDatei = "TEST.xls"
Ordner = CODESRV & "\went-trans$\"
Extension = "TRAN*.*"
dName = Dir(Ordner & Extension)
iFile = FreeFile
sFileA = "S:\WGT.txt"
maxZeilen = 0
Zeile = 1
Open sFileA For Input As iFile
Do Until EOF(iFile)
Line Input #iFile, sTxt
maxZeilen = maxZeilen + 1
Loop
Close
iFile = FreeFile
Open sFileA For Input As iFile
ReDim WGT_Array(3, maxZeilen)
Do Until EOF(iFile)
Line Input #iFile, sTxt
WGT_Array(1, WGT_Zeilen) = CStr(Left(sTxt, 3)) 'WGT
WGT_Array(2, WGT_Zeilen) = CStr(Mid(sTxt, 5, 6)) 'BestellNr
WGT_Array(3, WGT_Zeilen) = CStr(Right(sTxt, Len(sTxt) - 11)) 'Bezeichnung
WGT_Zeilen = WGT_Zeilen + 1
Loop
Close
iCounter = 1
iFile = FreeFile
sFile = Application.Path & "\Produkt.dat"
Open sFile For Output As iFile
Do While dName <> ""
n = n + 1
If dName = Workbooks(XLSDatei).Sheets("TRANS-Dateien").Range("A" & n) Then GoTo Weiter
sFileB = Ordner & dName
AnzahlTrans = 0
Zeile = 1
Open sFileB For Input As iFile + 1
Do Until EOF(iFile + 1)
Line Input #iFile + 1, sTxt
AnzahlTrans = AnzahlTrans + 1
Loop
Close iFile + 1
Open sFileB For Input As iFile + 1
Do Until EOF(iFile + 1)
Line Input #iFile + 1, sTxt
'Zähler = 4 +1
'Gedruckt = 1 +1
'Dateiname = 20 +1 dName
'Datum = 10 +1 CStr(Mid(sTxt, 62, 10))
' = 3 +1 CStr(Mid(sTxt, 46, 3))
'TRANS ID = 12 CStr(Mid(sTxt, 12, 12))
'BestellNr. = 6 +1 CStr(Mid(sTxt, 24, 6))
'WGT = 3 +1
'Bezeichn. = offen
'Auftrag ID CStr(Mid(sTxt, 49, 13)) nichtverwendet
For Zeile = 1 To AnzahlTrans
WGTOK = False
x = iCounter
For w = 2 To WGT_Zeilen - 1
If WGT_Array(2, w) = CStr(Mid(sTxt, 24, 6)) Then
Print #iFile, iCounter & Space(4 - Len(x)) & "0" & Space(1) & dName & Space(1) & _
CStr(Mid(sTxt, 62, 10)) & Space(1) & _
CStr(Mid(sTxt, 46, 3)) & Space(1) & _
CStr(Mid(sTxt, 12, 12)) & Space(1) & _
CStr(Mid(sTxt, 24, 6)) & Space(1) & _
WGT_Array(1, w) & Space(1) & WGT_Array(3, w)
WGTOK = True
Exit For
End If
Next w
If WGTOK = False Then
Print #iFile, iCounter & Space(4 - Len(x)) & "0" & Space(1) & dName & Space(1) & _
CStr(Mid(sTxt, 62, 10)) & Space(1) & _
CStr(Mid(sTxt, 46, 3)) & Space(1) & _
CStr(Mid(sTxt, 12, 12)) & Space(1) & _
CStr(Mid(sTxt, 24, 6)) & Space(1)
End If
iCounter = iCounter + 1
Next Zeile
Schliessen:
Loop
Close iFile + 1
Weiter:
dName = Dir()
'Call refreshPB
Loop
Close iFile
Workbooks.OpenText _
Filename:=sFile, _
DataType:=xlDelimited, _
Tab:=False, _
semicolon:=False, _
comma:=False, _
Space:=False, _
other:=False
MsgBox "Weiter"
ActiveWorkbook.Close savechanges:=False
End Sub
Gruß Dietmar
PS (Bin Montag wieder hier)
Gruß dietmar