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 |
|
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.lua" ' Dateinamen vorgeben
If Dir(sFilename) <> "" Then ' Ist Datei vorhanden?
iff = FreeFile
Open sFilename For Input As iff ' Datei öffnen
sData = Input(LOF(iff), iff) ' Daten in Array einlesen
Close iff ' Datei schließen
For iZeile = 2 To WSh.Cells(Rows.Count, "A").End(xlUp).Row ' Letzte Zeile in Spalte
sANr = WSh.Cells(iZeile, "A").Value
If sANr <> "" Then ' Zelle nicht leer
sUNr = WSh.Cells(iZeile, "B").Value
If sUNr <> "" Then ' Zelle nicht leer
sSep1 = "[" & Chr$(34) & sANr & Chr$(34) & "] = {" & vbCrLf
sSep2 = vbCrLf & "},"
sWert = ""
If InStr(sData, sSep1) > 0 Then
sWert = Split(Split(sData, sSep1)(1), sSep2)(0) ' Artikelnummer extrahieren
End If
sSep1 = " [" & Chr$(34) & sUNr & Chr$(34) & "] = "
If InStr(sWert, sSep1) Then
sWert2 = Split(Split(sWert, sSep1)(1), vbCrLf)(0) ' Unternummern extrahieren
If Right(sWert2, 1) <> "," Then ' Nur ein Wert?
sUUNr = WSh.Cells(iZeile, "C").Value
If sUUNr <> "" Then
sSep2 = " },"
sWert2 = Split(Split(sWert, sSep1)(1), sSep2)(0) ' Unternummern extrahieren
sSep1 = " [" & sUUNr & "] = "
If InStr(sWert2, sSep1) > 0 Then
sWert2 = Split(Split(sWert2, sSep1)(1), ",")(0) & "," ' Unterunternummer extrahieren
End If
End If
End If
WSh.Cells(iZeile, "D").Value = Left$(sWert2, Len(sWert2) - 1)
End If
End If
End If
Next iZeile
End If
End Sub
|