VBA i Excel - HJÆÆLP

Skulle nok være muligt!

Hvordan er de enkelte filer organiseret?

Salg er vel en mappe med 12 faner.
Er kundevaluta i en mappe for sig selv eller?
Tilsvarende vedr. Valutakurser?

Mvh

Mappen hedder salgsdata og her ligger 12 filer salg200501, ...., salgs200512.

Så er der en mappe der hedder valutakurser hvor filerne valuta200501, ...., salg200512 ligger.

Filen kundevaluta ligger i en mappe der hedder diverse

Har du Access installeret?
Det er nemlig en type opgave, som er 1000 gange nemmere at løse ved at importere dine regneark ind i Access, og så lave en rapport her (eller for den sags skyld bare lave forepørgslen i Access og så eksportere det færdige resultat til Excel, hvis du foretrækker det).

Selvfølgelig kan det også lade sig gøre i Excel, men det bliver både besværligt og sløvt. :-)

sidder med samme problem...
kjulius>> hvordan kan det lade sig gøre i excel ?

jeg har en ide, med hvor man åbner de enkelte dokumenter via nedenstående kode, men det fuldender langt fra problemet...

Public Sub FindWorkbook()
    Dim wb As Workbook
    Dim WorkbookFound As Boolean

    WorkbookFound = False
    For Each wb In Workbooks
        If wb.Name = UCase("Solvsamp.xls") Then WorkbookFound = True
    Next wb

    If WorkbookFound Then
        Workbooks("Solvsamp.xls").Activate
    Else
        Workbooks.Open Filename:= _
            "F:\kap2\salgsdata.xls"
    End If
End Sub

Løsning er programmeret - afsendes i morgen...

I Userformen fra 1. løsning (Find Kunde) er indsat en knap, der kalder
OmregnValuta i modulet MODULE1, der indeholder nedenstående kode:

Const xSti1 = "D:\Eksperten\FindKunde_Valuta\"      'Diverse.xls // TILPASSES
Const xSti2 = "D:\Eksperten\FindKunde_Valuta\"      'ValutaKurser.xls // -"-

Dim xlsDiverse As Object, xlsValutaKurser as Object

Sub omregnValuta()                                  'ProgramStart
    åbnDiverse
    åbnValutaKurser
   
    gennemløbSalgsMåneder
   
    xlsDiverse.Quit
    xlsValutaKurser.Quit
   
    Set xlsDiverse = Nothing
    Set xlsValutaKurser = Nothing
End Sub
Private Sub gennemløbSalgsMåneder()
Dim arkNr, række, maxrækker, knr, valuta
    For arkNr = 1 To ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets(arkNr).Activate
        ActiveSheet.Cells(1, 1).Select
        maxrækker = ActiveCell.SpecialCells(xlLastCell).Row
           
            For række = 2 To maxrækker      'Overskrift i række 1
                If Cells(række, 1) <> "" Then
                    knr = Cells(række, 1)
                    valuta = findKundeValuta(knr)
                    If valuta <> "" And valuta <> DDK Then
                            kurs = findKurs(arkNr, valuta)
                            If kurs <> 0 Then
                                Cells(række, 3) = (Cells(række, 2) * kurs) / 100
                            Else
                                MsgBox ("Kurs for " + valuta + "i måned: " + CStr(arkNr) + " findes ikke")
                            End If
                    Else
                        MsgBox ("Valuta for kundenr." + CStr(knr) + " kunne ikke findes!")
                    End If
                End If
            Next række
        Next arkNr
    findKunde = ""
End Sub
Private Function findKundeValuta(knr)
Dim række, maxrækker
    With xlsDiverse
        maxrækker = .ActiveCell.SpecialCells(xlLastCell).Row
        For række = 2 To maxrækker
            If .Cells(række, 1) = knr Then
                findKundeValuta = .Cells(række, 2)
                Exit Function
            End If
        Next række
    End With
    findKundeValuta = ""
End Function
Private Function findKurs(arkNr, valuta)
Dim række, maxrækker
    With xlsValutaKurser
        .Sheets(arkNr).Activate
        maxrækker = .ActiveCell.SpecialCells(xlLastCell).Row
        For række = 2 To maxrækker
            If .Cells(række, 2) = valuta Then
                findKurs = .Cells(række, 3)
                Exit Function
            End If
        Next række
    End With
    findKurs = 0
End Function
Private Sub åbnDiverse()
    Set xlsDiverse = CreateObject("Excel.application")
   
    With xlsDiverse
        .Workbooks.Open xSti1 + "Diverse.xls"
        .Visible = False
    End With
   
End Sub
Private Sub åbnValutaKurser()
    Set xlsValutaKurser = CreateObject("Excel.application")
   
    With xlsValutaKurser
        .Workbooks.Open xSti2 + "ValutaKurser.xls"
        .Visible = False
    End With
End Sub

Alle filer kan evt. sendes - mail til: pb@supertekst-it.dk

Det ser lækkert ud, må se om jeg kan få det til at virke

Jeg har forresten smidt alle mine filer ind i et array... er det så samme fremgangsmåde som overstående?

Du får et svar- i tilfælde af, at du er tilfreds med den viste løsning.

-

Hvor meget har du smidt i et array? I hvor mange dimensioner? - er det valutakurser og Diverse - så skal søgningen ændres!

Det er kundeid og valutakoden jeg har smidt ind i et array med 2 dimensioner