index van XML

Status
Niet open voor verdere reacties.
I

Interface

Gebruiker
Lid geworden
27 jan 2009
Berichten
156
Ik probeer een (HR)XML bericht te converteren met voor de tags een soort van index.

Nu ben ik ergens vanmiddag begonnen, maar het lukt me niet helemaal om dit zo te converteren. Niet gedacht dat zoiets zo lastig kan zijn. Ik ben bang dat mijn aanpaak niet helemaal juist is en veel beter/efficiënter kan.

Zou iemand hier mij op weg kunnen helpen? Opzich lukt het mij meestal wel met vba, maar zoals ik aangaf, ik heb het met dit dingetje toch wat lastig.

Hopelijk kan iemand mij verder helpen, of een zetje in de goede richting...

In het oefen bestand op tabblad 1 het originele stukje xml bericht (van internet afgehaald ergens dus geen persoonlijke data van iemand), op tabblad 2 een voorbeeld van het gewenste resultaat (dat is tevens de naam van het betreffende tabblad), daarnaast een tabblad met de naam conversie waar het stukje script wat ik al heb de geconverteerde data naar toeschrijft.
 

Bijlagen

  • helpmij_XML.xls
    55,5 KB · Weergaven: 23
Waarvoor wil je die indexnummers gebruiken ?

Code: 
Sub M_snb()
  sn = Blad1.Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    Select Case Len(LTrim(Left(sn(j, 1) & Space(30), 16)))
    Case 16
      If Left(Trim(sn(j, 1)), 2) <> "</" Then y = y + 1
      If Left(Trim(sn(j, 1)), 2) = "</" Then t = 0
           
      sn(j, 1) = Format(y, "0\.") & sn(j, 1)
    Case 12
      If Left(Trim(sn(j, 1)), 2) <> "</" Then t = t + 1
      If Left(Trim(sn(j, 1)), 2) = "</" Then n = 0
           
      sn(j, 1) = Format(y, "0\.") & Format(t, "0\.") & sn(j, 1)
    Case 8
      If Left(Trim(sn(j, 1)), 2) <> "</" Then n = n + 1
      If Left(Trim(sn(j, 1)), 2) = "</" Then p = 0
           
      sn(j, 1) = Format(y, "0\.") & Format(t, "0\.") & Format(n, "0\.") & sn(j, 1)
    Case 4
      If Left(Trim(sn(j, 1)), 2) <> "</" Then p = p + 1
      sn(j, 1) = Format(y, "0\.") & Format(t, "0\.") & Format(n, "0\.") & Format(p, "0\.") & sn(j, 1)
    End Select
   Next

   Blad2.Cells(1, 4).Resize(UBound(sn)) = sn
End Sub
 
Laatst bewerkt:
Ik heb het in ieder geval voor je gesplitst over twee kolommen.
Om de indexnummers te bepalen heb ik geen tijd meer vandaag.

Code: 
Sub Helpmij()
    
    Dim i                   As Integer
    Dim sq                  As Variant
    Dim intIndex            As Integer
    Dim intIndexSub         As Integer
    Dim intIndexSub2        As Integer
    Dim intIndexSub3        As Integer
    
    sq = Sheets("xmlorgineel").Cells(1).CurrentRegion.Resize(, 2)
    sv = sq
    For i = 1 To UBound(sq)
        Select Case UBound(Split(sq(i, 1), " ")) / 4
            Case Is = 0
                If i = 1 And i < UBound(sq) Then
                    intIndex = 1
                    intIndexSub = 1
                    intIndexSub2 = 1
                    intIndexSub3 = 1
                    sv(i, 1) = intIndex
                    sv(i, 2) = sq(i, 1)
                Else
                    If Left(sq(i - 1, 1), 2) <> 1 Then
                        intIndex = intIndex + 1
                        intIndexSub = 1
                        intIndexSub2 = 1
                        intIndexSub3 = 1
                       
                         sv(i, 2) = sq(i, 1)
                         sv(i, 1) = intIndex
                    Else
                        sv(i, 2) = sq(i, 1)
                        sv(i, 1) = intIndex
                    End If
                End If
            Case 1 To 1.75
                
                sv(i, 2) = sq(i, 1)
                sv(i, 1) = intIndex & "." & intIndexSub
                If (UBound(Split(sq(i + 1, 1), " ")) / 4) < 1.75 Then intIndexSub = intIndexSub + 1
            Case 2 To 2.75
                sv(i, 2) = sq(i, 1)
                sv(i, 1) = intIndex & "." & intIndexSub & "." & intIndexSub2
                If (UBound(Split(sq(i + 1, 1), " ")) / 4) > 2.75 Then intIndexSub2 = intIndexSub2 + 1
            Case 3 To 3.75
                sv(i, 2) = sq(i, 1)
                sv(i, 1) = intIndex & "." & intIndexSub & "." & intIndexSub2 & "." & intIndexSub3
                If (UBound(Split(sq(i + 1, 1), " ")) / 4) < 2.75 Then intIndexSub3 = intIndexSub3 + 1
        End Select
    Next i
    
    Sheets("Conversie").Range("a1").Resize(UBound(sq), 2) = sv
    
End Sub

Dit..
Code: 
UBound(Split(sq(i, 1), " ")) / 4

..mag je ook zo schrijven.
Code: 
UBound(Split(sq(i, 1))) / 4

Daar de standaard scheidingsteken een spatie is in Split.
 
SNB en HSV,

Ergens had ik niet anders verwacht van de vba Guru's hier! Super bedankt! Gisteren kreeg ik er hoofdpijn van....

..mag je ook zo schrijven.
Klik om te vergroten...

Ah dat wist ik niet, ik leer nog dagelijkst van jullie code!

Waarom ik de index nodig heb is om een soort van referentie te houden bij het terug ontleden van. Op deze manier kan ik ergens de originele indeling 'bewaren' in mn code.

Zijn er jullie inziens betere manier om dit aan te pakken, ergens ben ik er wel nieuwsgierig naar...
 
Er valt altijd nog wel iets te verbeteren:

Code: 
Sub M_snb()
  st = Array(0, 0, 0, 0, 0)
  sn = Blad1.Cells(1).CurrentRegion
  
  For j = 1 To UBound(sn)
    y = (16 - Len(LTrim(Left(sn(j, 1) & Space(30), 16)))) \ 4
    
    If Left(Trim(sn(j, 1)), 2) <> "</" Then
        st(y) = st(y) + 1
    Else
        st(y + 1) = 0
    End If
    
    sn(j, 1) = Split(Replace(Join(st, "_"), "_", ".", , y), "_")(0) & sn(j, 1)
  Next

  Blad2.Cells(1, 4).Resize(UBound(sn)) = sn
End Sub
 
Laatst bewerkt:
Wow:eek:

Hoe dan? Tis zo kort haha....

"@.@.@.@."
Klik om te vergroten...
Looks cool! Al wordt dit aardig rocketscience, ik kan het normaal wel ontleden maar hier moet ik echt even voor gaan zitten.
 
Laatst bewerkt door een moderator:
Svp niet quoten.
Loop met F8 door de code, dan wordt het vanzelf duidelijk.
Ik heb de code in #5 nog enigszins gewijzigd.
Voor het geval een nummer groter is dan 9 heb ik nu een andere methode gebruikt.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan