19. november 2006 - 10:00Der er
10 kommentarer og 1 løsning
Gennemsøgning af et range efter en dato
Hvem kan hjælpe med: opgaven består i at gennemsøge et range, og markere ens datoer og slette indholdet i de rækker hvori datoerne optræder. I den forbindelse har jeg forsøgt mig med følgende kode. Findes der en bedre metode? hvis ikke vil jeg gerne have hjælp til:
1. at ændre loopet, så jeg får overskrevet indholdet i hele rækken som indeholder et match 2. at undgå fejl i sidste betingelse i Loop linien: And C.Address <> firstAddress, når sidste linie i mit range rammes.
Sub søg_dato()
Dim søg As Date søg = InputBox("Indtast data: ", "Dato")
With Worksheets(3).Range("A4", Range("A65536").End(xlUp))
Set C = .Find(søg, LookIn:=xlValues) If Not C Is Nothing Then firstAddress = C.Address Do C.Value = " " Set C = .FindNext(C) ' find næste Loop While Not C Is Nothing And C.Address <> firstAddress End If End With End Sub
bruger selv denne marker kolonne (kun 1) der skal testes for dubletter ved evt. dubletter slettes hele rækken.
Sub SletDubletter() ' Slet i markeret kolonne Dim c, r, t, t2 If Selection.Columns.Count > 1 Then MsgBox ("Kun 1 kolonne!"): Exit Sub c = ActiveCell.Column r = Cells(65500, c).End(xlUp).Row Range(Cells(1, c), Cells(65500, c).End(xlUp)).Select For t = 1 To r If Cells(t, c) <> "" Then For t2 = t + 1 To r If Cells(t, c) = Cells(t2, c) Then Cells(t2, c) = "" End If Next End If Next On Error Resume Next Selection.Columns.SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp If MsgBox("Skal liste sorteres", vbYesNo, "Fjern dubletter") = vbYes Then Selection.Sort Key1:=Range(ActiveCell.Address), Order1:=xlAscending End If ActiveCell.Select End Sub
Hvis du vil tømme rækkerne, hvor kriteriet er opfyldt, så kan denne bruges,der bliver så tomme rækker imellem data.
Sub søg_dato()
Dim søg As Date, Data As Variant, I As Long søg = InputBox("Indtast data: ", "Dato")
Data = Worksheets(3).Range("A1", Range("A65536").End(xlUp)) For I = 4 To UBound(Data) If Data(I, 1) = søg Then Rows(I & ":" & I).ClearContents End If Next End Sub
Det er ikke en søgning på dubletter. Jeg skal have fjernet alle ens datoer. En række produkter er ankommet d. 15.11.2006. på et senere tidspunkt skal registreringen af disse produkter på den pågældende dato fjernes. Der er mange andre datoer i kolonnen. Det er formålet med proceduren
Dim søg As Date, Data As Variant, I As Long søg = InputBox("Indtast data: ", "Dato")
Data = Worksheets(3).Range("A1", Range("A65536").End(xlUp)) For I = 4 To UBound(Data) If Data(I, 1) = søg Then Range("A" & I & ":F" & I).ClearContents End If Next End Sub
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.
