17. marts 2006 - 21:59Der 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 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
De fleste virksomheder har efterhånden bevist, at AI virker.
Pilotprojekter leverer resultater. Medarbejdere bruger generative AI-værktøjer. Nye use cases dukker op på tværs af organisationen.
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
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
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.