2 dimensionele array

[sylvester-ponte]

hoi bifi

bedoel je zo iets?

let op alleen waarden boven in de kolommen A en B

Sub tabelmaken()
    optionbase = 1                            'eerste cell en een gebied = gebied(1,1)
    Dim totaal As Integer                   'totaal geeft totaal aantal lijnen aan
    Dim invoer As Range                    'hier staan jouw punten
    Dim uitvoer As Range                   'hier komt jouw tabel
    Dim tellerKolomA As Integer         'tellerKolomA telt het aantal unike punten in kolom "A"
    Dim teller As Integer
    Dim kolomA As Integer
    Dim kolomB As Integer
    kolomA = 1
    kolomB = 2
    Cells.NumberFormat = "@"              'zet alle cellen op tekst formaat
    
    If Cells(1, kolomA) = "" Then
        MsgBox "A1 is  leeg   de invoer moet op bovenaan in de eerste twee kolommen staan"
        End
    End If
    
    totaal = 0                                          'totaalaantal punten in kolom A
    Do
        totaal = totaal + 1
    Loop Until Cells(totaal, 1) = ""
    totaal = totaal - 1
    
    Rows("1:1").Select                                'ruimte maken boven de eerste "lijn" dit maakt het programma eenvoudiger
    Selection.Insert Shift:=xlDown
    
    Set invoer = Range(Cells(2, kolomA), Cells(totaal + 1, kolomB))
                                  'nu gaan we sorteren
    invoer.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
    
    Set uitvoer = Range("D2")                   'de plaats van de tabel wordt hier door bepaald
    
    tellerKolomA = 0
    For teller = 1 To totaal
        uitvoer(0, teller) = invoer(teller, kolomB)
        If invoer(teller, kolomA) <> invoer(teller - 1, kolomA) Then             'hier het voordeel van de toegevoegde ruimte
            tellerKolomA = tellerKolomA + 1
            uitvoer(tellerKolomA, 0) = invoer(teller, kolomA)
        End If
        uitvoer(tellerKolomA, teller) = "x"
    Next teller
    Set uitvoer = Range(Cells(1, 3), Cells(tellerKolomA + 1, teller + 2))
    uitvoer.Select
End Sub

probeer het eens uit door met F8 (stap voor stap ) het programma te runnen

groet sylvester

 

[Axel Hagg]

Dag Bifi,

Ga je nog in op mijn oplossing, of kan ik dit als afgedaan beschouwen? Zo nee, geef dan meteen een echte uitleg van wat de bedoeling is, want ik begrijp wel wat je beoogt maar ik heb te weinig informatie om dat in een code om te zetten.Probeer eens stap voor stap te vertellen wat je doet als je het handmatig doet.

Gegroet,

Axel.

 

[bifi]

hoi Axel

Sorry ik was er effe een paar dagen tussen uit.

Ik heb vandaag de juiste oplossing gevonden.

Je bent heel fel bedankt voor de uitleg en de moeite die je gedaan heb, kheb er veel aan gehad.

groeten bifi

 

[sylvester-ponte]

hoi Bifi

ik ben benieuwd naar de oplossing de oplossing die je nu gebruikt

groetjes Sylvester