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, sWert As String
Dim sANr As String, sUNr As String, sUUNr As String
Dim sSep1 As String, sSep2 As String, csSep As String
Set WSh = ThisWorkbook.Worksheets("Tabelle3") ' Datei referenzieren
sFilename = "C:\Users\voltm\Desktop\Auctionator.lua" ' Dateinamen vorgeben
csSep = "[" & Chr$(34) & "#" & Chr$(34) & "] = "
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
sWert = ""
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 = Replace(csSep, "#", sANr) & "{" & vbCrLf
sSep2 = vbCrLf & "},"
If InStr(sData, sSep1) > 0 Then
sWert = Split(Split(sData, sSep1)(1), sSep2)(0) ' Artikelnummer extrahieren
End If
sSep1 = Replace(csSep, "#", sUNr)
If InStr(sWert, sSep1) Then
sWert = Split(sWert, sSep1)(1) ' Unternummern extrahieren
If sWert Like "{*" Then
sUUNr = WSh.Cells(iZeile, "C").Value
If sUUNr <> "" Then
sSep1 = "[" & sUUNr & "] = "
If InStr(sWert, sSep1) > 0 Then
sWert = Split(sWert, "[" & sUUNr & "] = ")(1) ' Unterunternummer extrahieren
End If
End If
End If
WSh.Cells(iZeile, "D").Value = Split(sWert & ",", ",")(0) ' Wert einpflegen
End If
End If
End If
Next iZeile
End If
End Sub
|