Valuta og Salsdata for 11 aar !
Hej!Jeg skal ud fra 3 forskellige filer - salgdata for 11 aar (1999-2009), valutakurser for 11 aar, samt en fil over hvilke valuta de forskellige kunder har brugt, udregne kundernes bel'b i danske kroner.
Herunder ses en kode for afvikling af aaret 1999, men jeg ville gerne kunne gennemfoere samme kode for alle 11 aar. Hvordan goeres dette smartest ?
Public Sub Main()
'Først erklæres variablerne:
Dim wbSalgsdata99 As Workbook
Dim wbKundevaluta As Workbook
Dim wbValutaKurs99 As Workbook
Dim rngSalg As Range
Dim rngKundeNr As Range
Dim rngSalgsKundeNr As Range
Dim rngNr As Range
Dim rngISO As Range
Dim rngKursMdr As Range
'Der erklæres en tællervariabel:
Dim i As Integer
'De følgende variabler erklæres:
Dim strValuta As String
Dim strSalgsÅr As String
Dim strSalgsMdr As String
Dim rngMdr As Range
Dim DblKurs As Double
Dim DblBeløb As Double
Dim DblKrBeløb As Double
'Først undersøges om filen Salgsdata99.xlsm findes på den ønskede placering:
'Hvis den er tom, returneres en msgbox, og programmet afsluttes.
If Dir(ThisWorkbook.Path & "\salgsdata/Salgsdata 1999.xlsx") = "" Then
MsgBox "Filen ""Salgsdata99"" kan ikke indlæses og programmet afbrydes derfor.", vbOKOnly + vbCritical, "Mangler ønsket datafil"
Exit Sub
End If
'hvis filen findes, åbnes den og der sættes en ankercelle:
Set wbSalgsdata99 = Workbooks.Open(ThisWorkbook.Path & "\salgsdata/Salgsdata 1999.xlsx")
'På samme måde undersøges om filen kundevaluta99.xlsx findes på den ønskede placering
If Dir(ThisWorkbook.Path & "\kundevaluta.xlsx") = "" Then
MsgBox "Filen ""Kundevaluta"" kan ikke indlæses og programmet afbrydes derfor.", vbOKOnly + vbCritical, "Mangler ønsket datafil"
Exit Sub
End If
'hvis filen findes, åbnes den og ankercellen sættes:
Set wbKundevaluta = Workbooks.Open(ThisWorkbook.Path & "\kundevaluta.xlsx")
'Der undersøges også om filen kurser1999.xlsx findes på den ønskede placering:
If Dir(ThisWorkbook.Path & "\valutakurser/kurser1999.xlsx") = "" Then
MsgBox "Filen ""kurser 1999"" kan ikke indlæses og programmet afbrydes.", vbOKOnly + vbCritical, "Mangler ønsket datafil"
Exit Sub
End If
'hvis filen findes, åbnes den og der sættes samtidig en ankercelle:
Set wbValutaKurs99 = Workbooks.Open(ThisWorkbook.Path & "\valutakurser/kurser1999.xlsx")
'Der sættes også en ankercelle på salgsarket:
Set rngSalg = wbSalgsdata99.Worksheets("Salgsdata 1999").Range("A1")
'gemmer området med kundeNr i salgsarket som rngSalgsKundeNr
With rngSalg
Set rngSalgsKundeNr = Range(.Offset(1, 1), .Offset(1, 1).End(xlDown))
End With
'Gemmer området med KursMdr i valutaarket:
Set rngKursMdr = wbValutaKurs99.Worksheets("Valutakurser 1999").Range("C2:N2")
With wbValutaKurs99.Worksheets("Valutakurser 1999").Range("B3")
Set rngISO = Range(.Offset(0, 0), .Offset(0, 0).End(xlDown))
End With
'gemmer området med kundeNr i kundevaluta-arket som rngKundeNr
Set rngKundeNr = wbKundevaluta.Worksheets("kundevalutaer").UsedRange.Columns(1)
'Indsætter overskrift i kolonnen med danske beløb:
rngSalg.Copy
rngSalg.Offset(0, 3).PasteSpecial Paste:=xlPasteFormats
rngSalg.Offset(0, 3).Value = "Beløb i Danske kroner"
'Looper over alle kundeNr'erne i salgsdata-arket
For Each rngNr In rngSalgsKundeNr
'søger efter kundeNr fra salgsarket i kundevaluta-arket
Set rngKundeNr = rngKundeNr.Find(what:=rngNr.Cells(1, 1), LookIn:=xlValues, Lookat:=xlWhole)
'Hvis kunden ikke findes, kommer en msgBox der fortæller brugeren at kundens valutakode
'ikke er opgivet, og programmet afsluttes.
If rngKundeNr Is Nothing Then
MsgBox ("Kundens valuta for købet, er ikke opgivet")
Exit Sub
'hvis kundeNr findes gemmes valutakoden
Else
strValuta = rngKundeNr.Cells(1, 2)
End If
'Salgsår, samt salgsmdr gemmes
strSalgsÅr = Right(rngNr.Offset(0, -1), 4)
strSalgsMdr = Mid(rngNr.Offset(0, -1), 4, 2)
strSalgsMdr = strSalgsÅr & "M" & strSalgsMdr
'der loopes over ISO'erne for at finde passende valuta
For i = 1 To rngISO.Rows.Count
'Hvis valuta er lig ISO koden, findes mdr, og kursen der matcher findes
If strValuta = rngISO.Cells(i, 1).Value Then
Set rngMdr = rngKursMdr.Find(what:=strSalgsMdr, LookIn:=xlValues, Lookat:=xlWhole)
'kursen gemmes
DblKurs = rngMdr.Cells(i + 1, 1)
Exit For
ElseIf strValuta = "DKK" Then
DblKurs = 100
End If
Next
'beløbet fra salgsarket
DblBeløb = rngNr.Offset(0, 1).Value
'Det danske beløb udregnes:
DblKrBeløb = DblBeløb * DblKurs / 100
'det danske beløb indsættes i kolonnen ved siden af det oprindelige beløb
rngNr.Offset(0, 2) = DblKrBeløb
rngNr.Offset(0, 2).Style = "Comma"
Next
End Sub