Avatar billede alen32 Nybegynder
17. marts 2006 - 21:59 Der er 8 kommentarer og
1 løsning

Makro hjælp!

Hej!
Hver måned får jeg en fil med 2 kolonner: i kolonne A er kundens nummer og navn, mens i kolonne B er antal kilo han har købt på en måned.
eks.
A                      B
145623 Jens Jensen    320
Jeg har 21 filer som jeg kalder salgsoversigt hvor jeg har kolonne A med kundens nr., kolonne B med kundens navn og kolonne c - z er antal kilo som kundens har købt fra januar 2004 frem til nu.
A      B            C(jan.04) d(feb.04)
123456  Nils Jensen  245      300  osv.

Jeg har fået her på eksperten nedenstående makro som overfører det antal kilo kunden har købt i denne måned til mine salgsoversigt filer dvs programmet finder den samme kunde og i kolonne AA i salgsoversigt filen skriver det antal kilo kunden har købt.
Problemmet opstår når jeg får en ny kunde. Dataene bliver ikke overført da kunde nr. ikke findes i de 21 ark. Jeg ønsker alle kunde nr. som ikke bliver overført markeret med rød.Det virker hvis jeg opdaterer et ark ad gangen, men hvis jeg opdaterer alle 21 ark bliver alle celler røde.
Her er makro:
Private Sub CommandButton3_Click()
Const sSalesSheetName As String = "Ark1"
Const sCellToWriteIn As String = "AF3"

Dim salesFile(1 To 21)


salesFile(1) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\150.xls"
salesFile(2) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\180.xls"
salesFile(3) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\200.xls"
salesFile(4) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\210.xls"
salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
'salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
salesFile(6) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\280.xls"
salesFile(7) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\320.xls"
salesFile(8) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\340.xls"
salesFile(9) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\420.xls"
salesFile(10) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\430.xls"
salesFile(11) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\510.xls"
salesFile(12) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\520.xls"
salesFile(13) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\560.xls"
salesFile(14) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\590.xls"
salesFile(15) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\600.xls"
salesFile(16) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\690.xls"
salesFile(17) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\750.xls"
salesFile(18) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\770.xls"
salesFile(19) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\870.xls"
salesFile(20) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\910.xls"
salesFile(21) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\950.xls"

Dim iSalesNo As Integer
Dim wkbNew As Excel.Workbook
Dim wkbSales As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim wksView As Excel.Worksheet
Dim lRowFrom As Long
Dim lRowTo As Long
Dim bFound As Boolean

'On Error GoTo CleanUp
Set wkbNew = ActiveWorkbook
Set wksImport = wkbNew.ActiveSheet

For iSalesNo = LBound(salesFile) To UBound(salesFile)
Set wkbSales = Application.Workbooks.Open( _
FileName:=salesFile(iSalesNo))
Set wksView = wkbSales.Worksheets(sSalesSheetName)

' 2-tallet her bestemmer hvilken
' række det første kundenr findes i( Update-filen)
For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
bFound = False
' 3-tallet her bestemmer hvilken række
' det første kundenrfindes i(Salgsview - filen)
For lRowTo = 3 To wksView.UsedRange.Rows.Count
If Val(wksImport.Cells(lRowFrom, 1).Value) = _
wksView.Cells(lRowTo, 2).Value Then
wksView.Cells( _
lRowTo, _
wksView.Range(sCellToWriteIn).Column _
).Value = _
wksImport.Cells(lRowFrom, 2).Value
bFound = True
Exit For
End If
Next lRowTo

If Not bFound Then
'Cells get red color if not transfered,
wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
End If
Next lRowFrom
Next iSalesNo

CleanUp:
Set wksImport = Nothing
Set wksView = Nothing
Set wkbNew = Nothing
Set wkbSales = Nothing

End Sub
18. marts 2006 - 09:03 #1
Nedenstående er ikke testet.

Private Sub CommandButton3_Click()
    Const sSalesSheetName As String = "Ark1"
    Const sCellToWriteIn As String = "AF3"
    Dim salesFile(1 To 21)
   
    salesFile(1) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\150.xls"
    salesFile(2) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\180.xls"
    salesFile(3) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\200.xls"
    salesFile(4) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\210.xls"
    salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
    'salesFile(5) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\250.xls"
    salesFile(6) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\280.xls"
    salesFile(7) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\320.xls"
    salesFile(8) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\340.xls"
    salesFile(9) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\420.xls"
    salesFile(10) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\430.xls"
    salesFile(11) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\510.xls"
    salesFile(12) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\520.xls"
    salesFile(13) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\560.xls"
    salesFile(14) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\590.xls"
    salesFile(15) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\600.xls"
    salesFile(16) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\690.xls"
    salesFile(17) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\750.xls"
    salesFile(18) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\770.xls"
    salesFile(19) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\870.xls"
    salesFile(20) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\910.xls"
    salesFile(21) = "L:\056\AFALLES\STATISTI\Salgsstatistikker\Smågris efoder\Tjørnehøj opfølgning enkeltafdelinger\950.xls"
   
    Dim iSalesNo As Integer
    Dim wkbNew As Excel.Workbook
    Dim wkbSales As Excel.Workbook
    Dim wksImport As Excel.Worksheet
    Dim wksView As Excel.Worksheet
    Dim lRowFrom As Long
    Dim lRowTo As Long
    Dim bFound As Boolean
    Dim colFound As New Collection
   
    'On Error GoTo CleanUp
    Set wkbNew = ActiveWorkbook
    Set wksImport = wkbNew.ActiveSheet
   
    For iSalesNo = LBound(salesFile) To UBound(salesFile)
        Set wkbSales = Application.Workbooks.Open( _
        Filename:=salesFile(iSalesNo))
        Set wksView = wkbSales.Worksheets(sSalesSheetName)
       
        ' 2-tallet her bestemmer hvilken
        ' række det første kundenr findes i( Update-filen)
        For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
            bFound = False
            ' 3-tallet her bestemmer hvilken række
            ' det første kundenrfindes i(Salgsview - filen)
            For lRowTo = 3 To wksView.UsedRange.Rows.Count
                If Val(wksImport.Cells(lRowFrom, 1).Value) = wksView.Cells(lRowTo, 2).Value Then
                    wksView.Cells(lRowTo, wksView.Range(sCellToWriteIn).Column).Value = _
                        wksImport.Cells(lRowFrom, 2).Value
                    bFound = True
                    Exit For
                End If
            Next lRowTo
           
            ' Adds all found row numbers to a collection
            If bFound Then
                On Error Resume Next
                colFound.Add wksImport.Cells(lRowFrom, 1).Address, CStr(wksImport.Cells(lRowFrom, 1).Address)
                On Error GoTo 0
            End If
           
        Next lRowFrom
    Next iSalesNo
   
    'Color all cells in A red
    wksImport.Range("A1:A" & CStr(wksImport.UsedRange.Rows.Count)).Interior.ColorIndex = 3
    'Remove the red colort from found cells.
    For lRowFrom = 1 To colFound.Count
        wksImport.Cells(colFound(lRowFrom), 1).Interior.ColorIndex = xlColorIndexNone
    Next lRowFrom
   
   
CleanUp:
    Set wksImport = Nothing
    Set wksView = Nothing
    Set wkbNew = Nothing
    Set wkbSales = Nothing

End Sub
Avatar billede alen32 Nybegynder
18. marts 2006 - 11:28 #2
Makroen stopper her:hele linie bliver gul
wksImport.Cells(colFound(lRowFrom), 1).Interior.ColorIndex = xlColorIndexNone
Avatar billede alen32 Nybegynder
18. marts 2006 - 11:31 #3
der står også run-time error 13 type mismatch
18. marts 2006 - 11:36 #4
udskift xlColorIndexNone med  xlColorIndexAutomatic  eller med  0, 1 eller 2
Avatar billede alen32 Nybegynder
18. marts 2006 - 11:46 #5
Der sker det samme linien bliver gul. Hvis jeg peger på xlColorIndexAutomatic så står der xlColorIndexAutomatic=-4105
wksImport.Cells(colFound(lRowFrom), 1).Interior.ColorIndex = xlColorIndexAutomatic
18. marts 2006 - 12:08 #6
bruger du 2003 ??
Har du prøvet med
wksImport.Cells(colFound(lRowFrom), 1).Interior.ColorIndex = 0
eller 1 eller 2
Avatar billede alen32 Nybegynder
18. marts 2006 - 14:41 #7
bruger 2002 excel. Jeg har prøvet med allle foreslåede muligheder, men får den samme fejlmeddelse.
19. marts 2006 - 07:35 #8
Sorry - jeg havde jo tilføjet adressen til collectionen og ikke Row... find linien der matcher og udskrift 2*Address med 2*Row som vist her

colFound.Add wksImport.Cells(lRowFrom, 1).Row, CStr(wksImport.Cells(lRowFrom, 1).Row)
Avatar billede alen32 Nybegynder
19. marts 2006 - 08:09 #9
Det virker! helt fantastisk.
Mange tak!
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
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

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