Avatar billede CamillaCeline Nybegynder
15. december 2009 - 12:58 Der er 1 kommentar

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
Avatar billede CamillaCeline Nybegynder
15. december 2009 - 13:03 #1
Alle salgdata ligger i en mappe for sig, hvilket valutakurserne ogsaa goer. Kunne man evt. lave en loop der loopede henover alle aartal, altsaa alle de forskellige workbooks????
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
Kategori
Kurser inden for grundlæggende programmering

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