Bekijk de onderstaande video om te zien hoe je onze site als een web app op je startscherm installeert.
Opmerking: Deze functie is mogelijk niet beschikbaar in sommige browsers.
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
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
If Err = 0 Then
Uitvoer(tellerBeginPunten, 0) = beginPunt
tellerBeginPunten = tellerBeginPunten + 1
End If
On Error Resume Next
collecieEindPunten.Add Item:=tellerEindPunten, key:=eindPunt
If Err = 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
bv 2 lijnen vertrekken vanuit A1 naar B1 dan moet kost 2 keer groter worden
wat is kost?
moeten er 2 lijnen van A1 naar B1 getrokken worden of moet de lijn 2 maal zo dik worden
geef eens een letterlijk voorbeeld hoe jou uitvoer naar AutoCat er uit moet komen te zien
aan de hand van jou voorbeeld
laat maar eens zien wat er moet gebeuren als er 2 lijnen van A1 naar B1 gaan
en wat als er 3 lijnen van A1 naar B1 gaan
'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
'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
Public hoofdMatrix
Public collecieBeginPunten As New Collection
Public collecieEindPunten As New Collection
Sub mijnMatrix()
Dim Rij As Integer
Dim Kolom As Integer
Dim tellerBeginPunten As Integer
Dim tellerEindPunten As Integer
Dim beginPunt As String
Dim eindPunt As String
Dim E As Integer
Dim teller As Integer
Cells.HorizontalAlignment = xlLeft
Set hoofdMatrix = 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
hoofdMatrix(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
hoofdMatrix(0, tellerEindPunten) = eindPunt
tellerEindPunten = tellerEindPunten + 1
End If
Rij = collecieBeginPunten(beginPunt)
Kolom = collecieEindPunten(eindPunt)
hoofdMatrix(Rij, Kolom) = hoofdMatrix(Rij, Kolom) + 1
teller = teller + 1
Loop
aantalLijnenPerPunt
End Sub
Sub aantalLijnenPerPunt()
Dim beginPunt
Dim eindPunt
Dim totaal As Integer
Dim uitVoer As Range
Set uitVoer = hoofdMatrix(collecieBeginPunten.Count + 4, 1) 'hier komt je nieuwe tabel
uitVoer(0, 0) = "Punt"
uitVoer(0, 1) = "aantal lijnen per punt"
For Each beginPunt In collecieBeginPunten
uitVoer(beginPunt, 0) = hoofdMatrix(beginPunt, 0)
totaal = 0
For Each eindPunt In collecieEindPunten
totaal = totaal + hoofdMatrix(beginPunt, eindPunt)
Next eindPunt
uitVoer(beginPunt, 1) = totaal
Next beginPunt
Set uitVoer = uitVoer(collecieBeginPunten.Count + 2, 1) 'hier komt nog een tabel
uitVoer.Select
For Each eindPunt In collecieEindPunten
uitVoer(eindPunt, 0) = hoofdMatrix(0, eindPunt)
totaal = 0
For Each beginPunt In collecieBeginPunten
totaal = totaal + hoofdMatrix(beginPunt, eindPunt)
Next beginPunt
uitVoer(eindPunt, 1) = totaal
Next eindPunt
End Sub
We gebruiken essentiële cookies om deze site te laten werken, en optionele cookies om de ervaring te verbeteren.