07. december 2007 - 16:51Der er
6 kommentarer og 1 løsning
Rette i makro
Jeg har brug for at få rettet i nedenstående makro, og kan ikke selv gennemskue det. Nye ændringer: Under Input er der nu tilføjet et ekstra selskab, således at der er værdier til række 3000. Under Bearbejdning har hvert selskab sin egen kolonne, så det nye selskab får kolonne S og så rykkes summeringen til kolonne T. Det er de to eneste ændringer, men jeg kan ikke helt overskue, hvor jeg skal rette det til i makroen.
Sub find() '---------------------------------------------- Application.Calculation = xlCalculationManual '---------------------------------------------- Dim adr As Range Dim adr4 As Range Dim søg As String Dim adr2, adr3, t, rk Dim s1, s2, s3, s4, s5, s6 Dim x, x1 Application.ScreenUpdating = False Sheets("Input").Range("B1").EntireColumn.Hidden = False '*NY* kolonne B i Input gøres synlig imens koden kører rk = Sheets("Bearbejdning").Cells(1000, 2).End(xlUp).Row 'finder sidste række med værdi i kolonne B Sheets("Bearbejdning").Range("C10:R1000") = "" '*NY* fjerner evt gl. tekst/værdi inden ny skrives ved Opdater Sheets("Bearbejdning").Range("C10:R" & rk) = 0 ' område C10:R? - hvor ? = sidste række med værdi i kolonne B On Error Resume Next
'---- indsætte værdier i Bearbejdning ------- For j = 1 To 16 søg = Sheets("Bearbejdning").Cells(8, j + 2) ' søg får værdien i række 8 kolone c til r efter tur For t = 1 To rk søg2 = Sheets("Bearbejdning").Cells(t + 9, 2) Set adr = Sheets("Input").Range("B30:B2600").find(what:=søg, LookIn:=xlValues, lookat:=xlWhole) adr2 = Sheets("Input").Range(adr.Address).End(xlDown).Row adr3 = Sheets("Input").Range(adr.Address).Row Set adr4 = Sheets("Input").Range("C" & adr3 & ":C" & adr2).find(what:=søg2, LookIn:=xlValues, lookat:=xlWhole) Sheets("Bearbejdning").Cells(t + 9, 2 + j) = adr4.Offset(0, 2).Value If Sheets("Bearbejdning").Cells(t + 9, 2) = "-" Then Sheets("Bearbejdning").Cells(t + 9, 2 + j) = "": Sheets("Bearbejdning").Cells(t + 9 + 1, 2 + j) = "" End If Next Next
1) ikke helt - fra 2600 til 3000. 2) Det er meget svært at forklare, men makroen samler data fra Input og Kurslister i en matrice i Bearbejdning. Under Input er der en masse selskaber og deres handler. fx: selskab x aktie a 100 aktie b 200 osv.
Under kurslister står er der så valgt nogle af disse aktier ud. Det overføres så alt sammen til bearbejdning således:
selskab x selskab y osv... Sum aktie a 100 100 aktie b 200 200 aktie c osv.
Det hele samles altså i én stor matrice. Problemet er nu, at der er kommet et ekstra selskab ind, så der er 3000 rækker under Input mod ca. 2600 før. Derudover giver det et problem med, at summen i sidste kolonne i Bearbejdning skal rykkes en kolonne (fra S til T) og at der i S nu indføres data for det nye selskab. Mit store problem består i at få overført data for det nye selskab til denne kolonne.
Sub find() '---------------------------------------------- Application.Calculation = xlCalculationManual '---------------------------------------------- Dim adr As Range Dim adr4 As Range Dim søg As String Dim adr2, adr3, t, rk Dim s1, s2, s3, s4, s5, s6 Dim x, x1 Application.ScreenUpdating = False Sheets("Input").Range("B1").EntireColumn.Hidden = False '*NY* kolonne B i Input gøres synlig imens koden kører rk = Sheets("Bearbejdning").Cells(1000, 2).End(xlUp).Row 'finder sidste række med værdi i kolonne B Sheets("Bearbejdning").Range("C10:S1000") = "" '*NY* fjerner evt gl. tekst/værdi inden ny skrives ved Opdater Sheets("Bearbejdning").Range("C10:S" & rk) = 0 ' område C10:S? - hvor ? = sidste række med værdi i kolonne B On Error Resume Next
'---- indsætte værdier i Bearbejdning ------- For j = 1 To 17 '16 søg = Sheets("Bearbejdning").Cells(8, j + 2) ' søg får værdien i række 8 kolone c til r efter tur For t = 1 To rk søg2 = Sheets("Bearbejdning").Cells(t + 9, 2) Set adr = Sheets("Input").Range("B30:B2710").find(what:=søg, LookIn:=xlValues, lookat:=xlWhole) adr2 = Sheets("Input").Range(adr.Address).End(xlDown).Row adr3 = Sheets("Input").Range(adr.Address).Row Set adr4 = Sheets("Input").Range("C" & adr3 & ":C" & adr2).find(what:=søg2, LookIn:=xlValues, lookat:=xlWhole) Sheets("Bearbejdning").Cells(t + 9, 2 + j) = adr4.Offset(0, 2).Value If Sheets("Bearbejdning").Cells(t + 9, 2) = "-" Then Sheets("Bearbejdning").Cells(t + 9, 2 + j) = "": Sheets("Bearbejdning").Cells(t + 9 + 1, 2 + j) = "" End If Next Next
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.
