Optimering af relation/matrix script
HalløjJeg har lavet et script, som egentligt virker ganske fint. Men det tager bare rigtig lang tid for at køre, vi snakker flere minutter her.
Det har nok noget at gøre med at jeg ikke har den vilde erfaring inden for VBA scripts.
Jeg kunne se fordelen i at bruge andre funktioner så som Index/Match. Men jeg kan simpelthen ikke få det til at fungere.
Formålet med scriptet:
Jeg bruger Excel 365 hvor jeg har 3 ark i et excel dokument.
Ark 1: Doc_Relations, er fyldt med En-Til-Mange relationer. Det vil sige at kol. A er dokumentet og kol.B-BI er de elementer som er relateret til det enkelte dokument.
Ark 2: Map, Dette er min matrix hvor rækkerne er repræsenteret af elementer og kolonnerne er repræsenteret af dokumenter.
Fidusen med mappet/matrixen er at overskueliggøre hvilke dokumenter der er relateret til det enkelte element, eller omvendt.
Mit scripts funktion:
Scriptet tager det første element fra Ark 2 og søger efter det i Ark 1 kol. B, række for række.
Hvis elementet bliver fundet startes en ny søgning i Ark 2. Her skal dokumentet findes i kolonnerne for at kunne sætte et "X" ud for det active element og den fundne dokument reference.
Bliver elementet ikke fundet i kol. B fortsættes "loopet" til de næste kol.
Scriptet er simpelt og funktionelt.
Bare ikke til de mængder af data som jeg gerne vil have den til at bearbejde. Her snakker vi om 1000-3000 rækker af data som kan strække sig over lige så mange kolonner.
Scriptet:
Sub Map_Doc_Relations()
Dim hjDocCol As Long
Dim hjDocRow As Long
For hjMapTagRow = 9 To 200
For hjDocCol = 2 To 100 'hjDocColEnd
For hjDocRow = 2 To 700 'hjDocRowEnd
If Doc_Relations.Cells(hjDocRow, hjDocCol).Value = Map.Cells(hjMapTagRow, 2).Value Then
For hjMapDocCol = 4 To 700
If Doc_Relations.Cells(hjDocRow, 1).Value = Map.Cells(2, hjMapDocCol).Value Then
Map.Cells(hjMapTagRow, hjMapDocCol).Value = "X"
GoTo hjSTOPMapDocCol
End If
Next hjMapDocCol
End If
hjSTOPMapDocCol:
Next hjDocRow
Next hjDocCol
Next hjMapTagRow
End Sub
