30. juni 2006 - 10:04Der er
10 kommentarer og 1 løsning
Lopslag via VB
Jeg skal bruge et Lopslag i VB... Jeg har et ark som har mange Lopslag, der er nok 300 X 30 af dem. det gør at arket bliver meget tungt og laver mange fejl.
Ideen er at få det i vb så den ikke skal bruge så meget tid på at åbne.
Vben skal gøre som lopslaget men bare over flere rækker.
I mappe 1.xls "ark1" i "E3:E76" er hvor formlen Lopslag er, Lopslager ser på værdien i "C3:C76" og søger på værdien i Mappe 2.xls "ark2" "A4:A300" Hvis værdien ud for den værdi den søger på er det skal den retunere "K4:K300" ud for hver enkelte celle, hvis der ikke er værdi skal den ikke gøre noget. VBen skal køre via en knap..
Dim i, o, p As Integer Dim arr(4 To 300, 1) As Variant
Windows("Mappe2.xls").Activate
For i = 4 To 300 arr(i, 0) = Sheets("Ark2").Cells(i, 1).Value arr(i, 1) = Sheets("Ark2").Cells(i, 11).Value Next i
Windows("Mappe1.xls").Activate
For o = 3 To 76 For p = 4 To 300 If Sheets("Ark1").Cells(o, 3).Value = arr(p, 0) Then Sheets("Ark1").Cells(o, 5) = arr(p, 1) Exit For End If Next p Next o
Brynil jeg har fået den til af virke, men man skal have arkne åbne for at kunne gøre det... kan man lave den om til selv at åbne de ark den skal hente værdier fra!?
Jeg har desværre ikke rigtig tid før i eftermiddag, men prøv at bruge makooptageren til at få koden til at åbne og lukke den pågældende fil. Koden kan du så indsætte omkring:
Windows("Mappe2.xls").Activate
For i = 4 To 300 arr(i, 0) = Sheets("Ark2").Cells(i, 1).Value arr(i, 1) = Sheets("Ark2").Cells(i, 11).Value Next i
Prøv dette og husk at sætte den korrekte sti til filen:
Dim i, o, p As Integer Dim arr(4 To 300, 1) As Variant
Application.ScreenUpdating = False Workbooks.Open Filename:="C:\Mappe2.xls" ' << korrekt sti indsættes
For i = 4 To 300 arr(i, 0) = Sheets("Ark2").Cells(i, 1).Value arr(i, 1) = Sheets("Ark2").Cells(i, 11).Value Next i
ActiveWorkbook.Close
Windows("Mappe1a.xls").Activate
For o = 3 To 76 For p = 4 To 300 If Sheets("Ark1").Cells(o, 3).Value = arr(p, 0) Then Sheets("Ark1").Cells(o, 5) = arr(p, 1) Exit For End If Next p Next o
Jeg kan se du har et spm. om åbning af fil. Forsøg med dette:
Dim i, o, p As Integer Dim arr(4 To 300, 1) As Variant
Application.ScreenUpdating = False
Dim WB As Workbook On Error Resume Next
Set WB = Workbooks("Mappe2.xls")
If WB Is Nothing Then Workbooks.Open Filename:="C:\Mappe2.xls" Else Windows("Mappe2.xls").Activate End If
On Error GoTo 0
For i = 4 To 300 arr(i, 0) = Sheets("Ark2").Cells(i, 1).Value arr(i, 1) = Sheets("Ark2").Cells(i, 11).Value Next i
ActiveWorkbook.Close
Windows("Mappe1.xls").Activate
For o = 3 To 76 For p = 4 To 300 If Sheets("Ark1").Cells(o, 3).Value = arr(p, 0) Then Sheets("Ark1").Cells(o, 5) = arr(p, 1) Exit For End If Next p Next o
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.
