Makro ändern: text auslesen
24.04.2013 20:53:23
Ramona
ich hatte vorgestern schon gute Hilfe bekommen, denn ich muss derzeit ein Makro programmieren zum Auslesen von textdateien. Mein bisheriges MAkro ist ganz unten.
Ich lese folgenden Ausdruck aus:
https://www.herber.de/bbs/user/85033.txt
Unten ist ein Auszug:
Wie man sieht, sind die Ergebnisse etwas länger. Die Formatierung bleibt gleich.
Ich habe Rudis makro für die erste Anfrage genommen und das Array auf 2 verkleinert (da ich nur noch den Namen und das Rating brauche).
Leider spuckt mir das Makro nur einen Teil der Ergebnisse, meist ohne Namen aus.
Ich sehe, dass das Makro das falsche "name" beim ersten Mal zieht - es landet gleich zwei "name" zu weit unten (in dieser Abfrage ist ein weiteres "name" eingezogen, so dass ich nur jedes dritte ziehen will.)
Ich habe herumexperimentiert und gesehen, dass das Makro aktuell nicht das richtige FEld erfasst ("name") es rutscht ins falsche.
Warum es nur jede rund 3. Zeile ausliest, verstehe ich nicht?
"totalResults": 98,
"groups": [
{
"type": "Recommended Places",
"items": [
{
"reasons": {
"count": 1,
"items": [
{
"type": "general",
"message": "This spot is popular"
}
]
},
"venue": {
"id": "4ade0cd3f964a520446921e3",
"name": "Theresienwiese",
"contact": {},
"location": {
"address": "Bavariaring",
"crossStreet": "Theresienhöhe",
"lat": 48.13166854919786,
"lng": 11.549849510192871,
"distance": 2412,
"postalCode": "80336",
"city": "München",
"country": "Germany",
"cc": "DE"
},
"canonicalUrl": "https://foursquare.com/v/theresienwiese/4ade0cd3f964a520446921e3",
"categories": [
{
"id": "4bf58dd8d48988d15f941735",
"name": "Field",
"pluralName": "Fields",
"shortName": "Field",
"icon": "https://foursquare.com/img/categories/parks_outdoors/default.png",
"parents": [
"Outdoors & Recreation"
],
"primary": true
}
],
"verified": false,
"stats": {
"checkinsCount": 5053,
"usersCount": 1802,
"tipCount": 18
},
"url": "http://de.wikipedia.org/wiki/theresienwiese",
"likes": {
"count": 29,
"groups": [
{
"type": "others",
"count": 29,
"items": []
}
],
"summary": "29 likes"
},
"like": false,
"rating": 9.18,
"beenHere": {
"count": 0,
"marked": false
},
"specials": [],
"photos": {
"count": 236,
"groups": []
},
"hereNow": {
"count": 1,
"groups": [
{
"type": "others",
"name": "Other people here",
"count": 1,
"items": []
}
]
}
},
"tips": [
{
"id": "4f495f09e4b09620886b9999",
"createdAt": 1330208521,
"text": "Come here during Oktoberfest!",
"canonicalUrl": "https://foursquare.com/item/4f495f09e4b09620886b9999",
"likes": {
"count": 0,
"groups": []
},
"logView": true,
"todo": {
"count": 4
},
"done": {
"count": 28
},
"user": {
"id": "22477478",
"firstName": "Visit Munich",
"gender": "none",
"photo": "https://is1.4sqi.net/userpix_thumbs/ZDDZMTIVCSSV32BM.png",
"type": "page",
"followers": {
"count": 2009,
"groups": []
},
"tips": {
"count": 20
},
"lists": {
"groups": [
{
"type": "created",
"count": 2,
"items": []
}
]
},
"homeCity": "München, Germany",
"bio": "",
"contact": {
"twitter": "visitmunich",
"facebook": "108378172646122"
}
}
}
],
"phrases": [
{
"phrase": "oktoberfest",
"sample": {
"entities": [
{
"indices": [
8,
19
],
"type": "keyPhrase"
}
],
"text": "... the Oktoberfest."
},
"count": 4
},
{
"phrase": "oktoberfest",
"sample": {
"entities": [
{
"indices": [
16,
27
],
"type": "keyPhrase"
}
],
"text": "... here during Oktoberfest!"
},
"count": 2
},
{
"phrase": "tradition",
"sample": {
"entities": [
{
"indices": [
16,
25
],
"type": "keyPhrase"
}
],
"text": "... im Festzelt Tradition nicht verpassen!"
},
"count": 1
}
],
"referralId": "e-0-4ade0cd3f964a520446921e3-0"
},
{
"reasons": {
"count": 1,
"items": [
{
"type": "general",
"message": "This spot is popular"
}
]
},
"venue": {
"id": "4ade0cd5f964a5204e6921e3",
"name": "Tierpark Hellabrunn",
"contact": {},
"location": {
"address": "Tierparkstr. 30",
"lat": 48.09969785289792,
MAKRO
Sub einlesen()
Dim sTmp, i As Long, j As Integer, n As Integer
Dim arrTmp, sItem As String, blnCat As Boolean
Dim objDaten As Object, arrDaten(), arr()
Dim arrHeader
Dim sFile As String
arrHeader = Array("Nr.", "Name", "rating")
ReDim arr(UBound(arrHeader))
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Datei wählen"
.AllowMultiSelect = False
If .Show = -1 Then
sFile = .SelectedItems(1)
End If
End With
If sFile "" Then
Set objDaten = CreateObject("Scripting.Dictionary")
Open sFile For Input As #1
sTmp = Split(Input(LOF(1), 1), vbCrLf)
Close #1
Do
'erste ID suchen
arrTmp = Split(sTmp(i), ":")
If UBound(arrTmp) > 0 Then
If LCase(Trim(Replace(arrTmp(0), Chr(34), ""))) = "id" Then
Exit Do
End If
End If
i = i + 1
Loop
Do
arrTmp = Split(sTmp(i), ":")
If UBound(arrTmp) > 0 Then
sItem = Trim(Replace(arrTmp(1), Chr(34), ""))
If Len(arrTmp(1)) Then
sItem = Left(sItem, Len(sItem) - 1)
Select Case LCase(Trim(Replace(arrTmp(0), Chr(34), "")))
Case "categories": blnCat = True
Case "id"
n = n + 1 + blnCat
If Not blnCat Then ReDim arr(UBound(arrHeader))
Case "name"
If blnCat Then
arr(2) = sItem
blnCat = False
Else
arr(0) = n
arr(1) = sItem
End If
Case "rating": arr(2) = sItem
End Select
objDaten(n) = arr
End If
End If
i = i + 1
Loop Until i > UBound(sTmp)
objDaten(0) = arrHeader
ReDim arrDaten(1 To objDaten.Count, 1 To UBound(arrHeader) + 1)
For i = 0 To n
arrTmp = objDaten(i)
For j = 0 To UBound(arrHeader)
arrDaten(i + 1, j + 1) = arrTmp(j)
Next
Next
With Sheets(1)
.Cells.Clear
.Cells(1, 1).Resize(UBound(arrDaten), UBound(arrDaten, 2)) = arrDaten
End With
End If
End Sub