01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51 |
|
Option Explicit
Sub Suche_in_Lua()
Dim WSh As Worksheet, iff As Integer, iZeile As Long
Dim sFilename As String, sData As String
Dim sANr As String, sUNr As String, sUUNr As String
Dim sSep1 As String, sSep2 As String, sWert As String, sWert2 As String
Set WSh = Worksheets("Tabelle3") ' Datei referenzieren
sFilename = "C:\Users\voltm\Desktop\MyLuaTest.txt" ' Dateinmaen vorgeben
iff = FreeFile
If Dir(sFilename) <> "" Then ' Ist Datei vorhanden?
Open sFilename For Input As iff ' Datei öffnen
sData = Input(LOF(iff), iff) ' Daten in Array einlesen
Close iff ' Datei schließen
End If
For iZeile = 1 To WSh.Cells(Rows.Count, "A").End(xlUp).Row 'Letzte Zeile in Spalte
sANr = WSh.Cells(iZeile, "A").Value
If sANr <> "" Then ' Zelle mit Suchbegriff nicht leer
sUNr = WSh.Cells(iZeile, "B").Value
If sUNr <> "" Then ' Zelle mit Suchbegriff nicht leer
sSep1 = "[" & Chr$(34) & sANr & Chr$(34) & "] = {" & vbCrLf
sSep2 = vbCrLf & "},"
On Error GoTo Fehler
sWert = Split(Split(sData, sSep1)(1), sSep2)(0) ' Artikelnummer extrahieren
sSep1 = " [" & Chr$(34) & sUNr & Chr$(34) & "] = "
sWert2 = Split(Split(sWert, sSep1)(1), vbCrLf)(0) ' Unternummern extrahieren
If Right(sWert2, 1) = "," Then ' Nur ein Wert?
WSh.Cells(iZeile, "D").Value = Split(sWert2 & ",", ",")(0)
Else ' Unterunternummer
sUUNr = WSh.Cells(iZeile, "C").Value
If sUUNr <> "" Then
sSep2 = " },"
sWert2 = Split(Split(sWert, sSep1)(1), sSep2)(0) ' Unternummern extrahieren
sSep1 = " [" & sUUNr & "] = "
sWert2 = Split(Split(sWert2 & ",", sSep1)(1), ",")(0) ' Unterunternummer extrahieren
WSh.Cells(iZeile, "D").Value = sWert2
End If
End If
On Error GoTo 0
Fehler:
End If
End If
Next iZeile
End Sub
|