'in kolom A staan beginPunten van lijnen in tekst fomnaat
'in kolom B staan eindPunten van lijnen in tekst formaat
'in één rij staat één lijn
'in kolom A mogen iedentieke punten staan in kolom B ook
'nu moet er een matrix gevormd worden met bovenin de unieke punten van kolom B
'en vertikaal de unieke punten van kolom A
'en op de kruispunten het aantal verbindingen
'omdat de punten unie moeten zijn, is een collectie met de unieke punten (tekst)als key
'en de plaats in de matrix als item, een makkerlijke oplossing om de matrix te benaderen
'zorg dat de lijst met punten begint op rij 1
Sub mijnMatrix()
Dim Rij As Integer
Dim Kolom As Integer
Dim Uitvoer
Dim collecieBeginPunten As New Collection
Dim collecieEindPunten As New Collection
Dim tellerBeginPunten As Integer
Dim tellerEindPunten As Integer
Dim beginPunt As String
Dim eindPunt As String
Dim E As Integer
Cells.HorizontalAlignment = xlLeft
Set Uitvoer = Range("d2")
tellerBeginPunten = 1
tellerEindPunten = 1
teller = 1
Do Until Cells(teller, 1) = ""
beginPunt = Cells(teller, 1)
eindPunt = Cells(teller, 2)
On Error Resume Next
collecieBeginPunten.Add Item:=tellerBeginPunten, key:=beginPunt
E = Err
On Error GoTo 0 'zo snel mogenlijk de error behandeling weer op normaal zetten
If E = 0 Then 'geen error dus er is een nieuw uniek item toegevoegd aan collectieBeginPunten
Uitvoer(tellerBeginPunten, 0) = beginPunt 'dit nieuwe beginpunt krijgt gelijk een plaats op de sheet
tellerBeginPunten = tellerBeginPunten + 1 'deze teller is eigenlijk niet nodig,kan ook de count gebruiken
End If
On Error Resume Next
collecieEindPunten.Add Item:=tellerEindPunten, key:=eindPunt
E = Err
On Error GoTo 0
If E = 0 Then
Uitvoer(0, tellerEindPunten) = eindPunt
tellerEindPunten = tellerEindPunten + 1
End If
Rij = collecieBeginPunten(beginPunt)
Kolom = collecieEindPunten(eindPunt)
Uitvoer(Rij, Kolom) = Uitvoer(Rij, Kolom) + 1
teller = teller + 1
Loop
End Sub
