Avatar billede HansJorgenJK Nybegynder
23. september 2014 - 15:42 Der er 1 løsning

Optimering af relation/matrix script

Halløj

Jeg 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
Avatar billede HansJorgenJK Nybegynder
14. oktober 2014 - 10:40 #1
LUKKET
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester