01. maj 2003 - 09:36Der er
10 kommentarer og 1 løsning
Excel - Autofilter + ændring af baggrundsfarve
Hejsa
Håber der er nogen, der kan hjælpe mig.
Jeg får løbende lister med kundeoplysninger, hvor jeg skal foretage en sammenligning af disse lister for at finde dubletter. Disse lister kopierer jeg ind i et nyt regneark, der består af disse 2 ark:
Gammel Ny
Til denne sammeligning har jeg indspillet følgende makro:
---Klip------
Sub Dubletter() ' ' Dubletter Makro ' Kontrollerer arket 'Gammel' for dubletter ' ' Genvejstast:Ctrl+æ ' Columns("B:B").Select Application.CutCopyMode = False Selection.Insert Shift:=xlToRight Range("B2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Gammel!R2C1:R500C1,1,FALSE)" Range(Selection, Cells(ActiveCell.Row, 1)).Select Range("B2").Select Selection.AutoFill Destination:=Range("B2:B500"), Type:=xlFillDefault Range("B2:B500").Select Range("A1").Select Selection.AutoFilter Selection.AutoFilter Field:=2, Criteria1:="<>#I/T", Operator:=xlAnd Rows("5:5").Select Range(Selection, Selection.End(xlDown)).Select With Selection.Interior .ColorIndex = 6 .Pattern = xlSolid End With Range("A1").Select Selection.AutoFilter Field:=2 Selection.AutoFilter Columns("B:B").Select Selection.Delete Shift:=xlToLeft Range("A1").Select End Sub
---Klip------
Problemet er desværre, at når jeg kører denne makro, så ændres baggrundsfarven for alle rækker fra A5 og opefter, fordi det var den første række under indspilningen.
Jeg vil gerne lave en markering, der fungerer således, at den markerer alle de synlige værdier, der er fremkommet via autofilter.
Range("A2").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.SpecialCells(xlCellTypeVisible).Select With Selection.Interior .ColorIndex = 6 .Pattern = xlSolid End With
Jeg kan desværre ikke få selve autofilter-delen til at virke, så jeg ekeperimeneterer med en anden løsning, der ser sådan ud:
---klip-----------
Sub Dubletter() ' ' Dubletter Makro ' Kontrollerer arket 'Gammel' for dubletter ' ' Genvejstast:Ctrl+æ '
Columns("B:B").Select Selection.Insert Shift:=xlToRight Range("B2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Gammel!R2C1:R500C1,1,FALSE)" Range("B2").Select Selection.AutoFill Destination:=Range("B2:B500"), Type:=xlFillDefault Range("B2:B500").Select Range("A1").Select For i = 1 To 500 Dim celle As String celle = "B" & i If (celle = "#I/T") Then Rows(i & ":" & i).Select With Selection.Interior .ColorIndex = 6 .Pattern = xlSolid End With End If Next i
End Sub
---klip-----------
Desværre virker dette heller ikke. Jeg tror fejlen ligger i for-løkken. Formentlig i selv sammenligningen: "If (celle = "#I/T") Then".
Jeg har ændret en smule i din makro, men ikke haft lejlighed til at teste den: Sub Dubletter() ' ' Dubletter Makro ' Kontrollerer arket 'Gammel' for dubletter ' ' Genvejstast:Ctrl+æ ' Dim Celle As Range Columns("B:B").Select Selection.Insert Shift:=xlToRight Range("B2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Gammel!R2C1:R500C1,1,FALSE)" Range("B2").Select Selection.AutoFill Destination:=Range("B2:B500"), Type:=xlFillDefault Range("B2:B500").Select Range("A1").Select For i = 1 To 500 Set Celle = Range("B" & i) If Celle.Value = CVErr(xlErrNA) Then Rows(i & ":" & i).Select With Selection.Interior .ColorIndex = 6 .Pattern = xlSolid End With End If Next i
Håber du har fået det ellers er her en variation af min egen dublikat-mærker
Sub MarkDuplicates() Dim AllCells As Range, cell As Range Dim NoDupes As New Collection Dim strCheck As String
Set AllCells = Range("A1:A500") On Error Resume Next For Each cell In AllCells NoDupes.Add cell.Value, CStr(cell.Value) Next cell Err.Clear
For Each cell In AllCells strCheck = CStr(cell.Value) If NoDupes(strCheck) <> 0 Then NoDupes.Remove strCheck If Err.Number <> 0 Then cell.EntireRow.Interior.ColorIndex = 6 cell.EntireRow.Interior.Pattern = xlSolid Err.Clear End If Next End Sub
For i = 2 To 500 Dim celle Dim vaerdi celle = "B" & i vaerdi = "#I/T" Range(celle).Select If ActiveCell.Text <> vaerdi Then Rows(i & ":" & i).Select With Selection.Interior .ColorIndex = 6 .Pattern = xlSolid End With End If Next i
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.
