VBA kan ikke finde rundt i åbne ark?
Jeg har følgende kode, men VBA kan ikke finde rundt i arkene. Derfor blvier mine tællere helt i skoven. bl.a. "antalhandler" og antalkunder bliver forkerte.Kan ikke selv finde fejlen. Man ku foresteille mig det er noget med activate sheet???
Option Explicit
Private Sub main()
'vi deklarer vores array, vi laver et statistik med 101 pladser da det må være rigeligt!
Dim projektmapper1(100) As String, Projektmapper2(100) As String
Dim sti1 As String, sti2 As String
Dim fil1 As String, fil2 As String
Dim sti11 As String, sti22 As String
Dim x As Integer, y As Integer
Dim tal1 As Integer, tal2 As Integer
Dim salg As Workbook
Dim valuta As Workbook
'vi deklarer stien til salgsdata filerne
sti1 = ThisWorkbook.Path & "\data\salgsdata\"
'deklarer filerne som skal indlæses
fil1 = Dir(sti1)
'indlæser filer indtil filnavn er tomt
Do While fil1 <> ""
'indlæser til array'et
projektmapper1(tal1) = fil1
'sætter tæller på
tal1 = tal1 + 1
'gentages for de øvrige matchende filer
fil1 = Dir
Loop
sti2 = ThisWorkbook.Path & "\data\valutakurser\"
fil2 = Dir(sti2)
Do While fil2 <> ""
Projektmapper2(tal2) = fil2
tal2 = tal2 + 1
fil2 = Dir
Loop
For x = 0 To tal1 - 1
For y = 0 To tal2 - 1
If Mid(projektmapper1(x), 11, 4) = Mid(Projektmapper2(y), 7, 4) Then 'ret til 9 hvis Excel7
sti11 = Left(sti1, Len(sti1))
sti22 = Left(sti2, Len(sti2))
Set salg = Workbooks.Open(sti11 & projektmapper1(x))
Set valuta = Workbooks.Open(sti22 & Projektmapper2(y))
Call udregn_dk(salg, valuta)
Workbooks(projektmapper1(x)).Close SaveChanges:=True
Workbooks(Projektmapper2(y)).Close SaveChanges:=True
End If
Next
Next
End Sub
'denne sub udregner alle beløb til danske kroner
Private Sub udregn_dk(ByRef salg As Workbook, valuta As Workbook)
Dim Kunder As Range
Dim KundeID As Integer
Dim Valuta2 As Range
Dim beløb As Currency
Dim antalKunder As Integer
Dim antalhandler As Integer
Dim i As Integer
Dim v As Integer
Dim dato As Date
Dim måned As Integer
Dim antalvalutaer As Integer
Dim omregnetbeløb As Currency
antalKunder = Workbooks.Open("kundevaluta").Worksheets("Kundevalutaer").UsedRange.Rows.Count
With salg
antalhandler = Range("a2").CurrentRegion.Rows.Count
End With
With salg
'kører en løkke for hver handel
For i = 1 To antalhandler
'finder kundeID, dato for køb, og beløbet
KundeID = Range("B1").Offset(i, 0)
dato = Range("B1").Offset(i, -1)
beløb = Range("B1").Offset(i, 1)
'tager det 4 ciffer, som er der måned er angivet og 2 cifre, dvs "01" til "12", ved "01" returneres 1
måned = Mid(dato, 4, 2)
'går tilbage til wb med kundedata
End With
With Kunder
'finder den valuta som kunden handler i
Set Valuta2 = .Find(What:=KundeID).Offset(0, 1)
'hvis det er danske kroner er det ikke nødvendigt at omregne og derfor udskrives beløbet med det samme
If Valuta2 = "DKK" Then
'når der handles i DKK, udskrives beløbet i cellen ved siden af
With salg
Range("B2").Offset(i, 2).Value = beløb 'kan der gøres noget, kører koden videre, kan det gøres hurtigere hvis det er i DKK??
End With
End If
End With
'går tilbage til valuta wb for at finde hvilken kurs der var for måneden med købet
With valuta
'
'finder antal af forskellige valutaer som virksomheden handler i
antalvalutaer = Range("B2").Rows.End(xlDown).Count
'kører en løkker der finder den valuta som der er handlet i
For v = 1 To antalvalutaer
'hvis ISO koden er den samme som valutaen gåes der videre og udregner beløbet
If Range("B2").Offset(v, 0) = Valuta2 Then
omregnetbeløb = Range("B2").Offset(v, måned) * beløb / 100
'går tilbage til salgs WB for at udskrive det omregnede beløb
With salg
'for at være sikker på at få den rigtige handel skal de oprindelige data overholdes før der må udskrives et beløb
If Range("B2").Offset(i, 0) = KundeID And Range("B2").Offset(i, -1) = dato And Range("B2").Offset(i, 1) = beløb Then
'udskriver det omregnede beløb
.Offset(i, 2).Value = omregnetbeløb
End If
End With
End If
Next
End With
Next
End With
'With salg
'
'
'.Offset(0, 2).Value = "Omregnet beløb"
'.Offset(0, 2).Font.Bold = True
'.Offset(0, 2).Borders.LineStyle = xlThick
'Columns.AutoFit
'End With
'save changes for arket
End Sub
