Question

这是我第一次来这里

我有一个代码可以删除和重复曾经在选择范围内合并的值，以便我可以对数据应用过滤器。（见下文）

Sub mergefiltro()

If MsgBox("select the desired range ?", vbYesNo) = vbNo Then Exit Sub

 Dim MergedCell As Range, FirstAddress As String, MergeAddress As String, MergeValue As Variant

 Application.FindFormat.MergeCells = True

Application.ScreenUpdating = False

   Do

     Set MergedCell = Selection.Find("", LookAt:=xlPart, SearchFormat:=True)

     If MergedCell Is Nothing Then Exit Do

     MergeValue = MergedCell.Value

     MergeAddress = MergedCell.MergeArea.Address

     MergedCell.MergeArea.UnMerge

     Range(MergeAddress).Value = MergeValue

   Loop

 Application.FindFormat.Clear
Application.ScreenUpdating = True

'Filter application

Selection.AutoFilter

End Sub

此代码将重复曾与其他单元合并的一个单元格中的值。

现在，我找不到一种方法可以继续（在同一个选择中）清除一行中的重复值...换句话说：我不想清除向下的所有重复单元格值（列方式），仅查找并清除Excel工作表右侧的所有重复单元格值（行方向）。

我遇到过这个：

Sub FindDups()

ScreenUpdating = False

FirstItem = ActiveCell.Value

SecondItem = ActiveCell.Offset(0, 1).Value

Offsetcount = 1

Do While ActiveCell <> ""

If FirstItem = SecondItem Then

ActiveCell.Offset(Offsetcount, 0).Value = ("")

Offsetcount = Offsetcount + 1

SecondItem = ActiveCell.Offset(Offsetcount, 0).Value

Else

ActiveCell.Offset(Offsetcount, 0).Select

FirstItem = ActiveCell.Value

SecondItem = ActiveCell.Offset(1, 0).Value

Offsetcount = 1

End If

Loop

ScreenUpdating = True

MsgBox "Done"

End Sub

但是这段代码完全符合我的要求：清除列中的重复值。我想要的是一个清除连续值（到右侧单元格）的代码。

有谁知道怎么做？

提前致谢

Answer 1

从第一个子记录中更改此行：

Range(MergeAddress).Value = MergeValue

到

Range(MergeAddress).Columns(1).Value = MergeValue

Answer 2

我在一张纸上使用带有列表的变体，在数据库上使用过滤器，过滤器

＆＃39;删除宏＆＃39;不要显示srceen ＆＃39; Application.ScreenUpdating = False ＆＃39; ＆＃39; A1标题上的例外列表和要删除的a2,3,4,5 表格（＆＃34;例外列表＆＃34;）。选择＆＃39;计算例外

d = ActiveWorkbook.Worksheets("Exception List").Range("A1", Range("A1").End(xlDown)).Rows.Count

＆＃39;激活数据库进行过滤表格（＆＃34; 1.原始数据＆＃34;）。激活

＆＃39;统计数据库数据（a3因为我的开始在a3，使用你需要的任何东西） F = ActiveWorkbook.Worksheets（＆＃34; 1.原始数据＆＃34;）。范围（＆＃34; A3＆＃34;，范围（＆＃34; A3＆＃34;）。结束（xlDown））。行。数+ 2 ＆＃39;循环每个例外

For i = 2 To d
'exception loop taking
  Sheets("Exception List").Select
Criteria1 = Range("a" & i).Value

Sheets("1. Raw Data").Select
 'filter x exception in loop at data base ( A to Z in my case)
ActiveSheet.Range("$A$3:$Z$" & F).AutoFilter Field:=5, Criteria1:= _
    Criteria1
  'down one of visible rows ( form header to first visible data)
  Range("a3").Select
   With Worksheets("1. Raw Data").AutoFilter.Range
     Range("a" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(3).Row).Select

结束

   'select all data with exception
Range(Selection, Selection.End(xlToRight).End(xlDown)).Select
    'erase exeptions
Selection.delete Shift:=xlUp
'erase filter
ActiveSheet.Range("$A$3:$Z$3").AutoFilter Field:=5

＆＃39;下一个例外接下来我

Application.ScreenUpdating = True


'by christian marcos

Answer 3

   sorry now on code everything
 > 'delete Macro dont show srceen
    > 
    > Application.ScreenUpdating = False
    > 
    > 
    > 'List of exception on A1 title and a2,3,4,5 to erase
    > 
    >  Sheets("sheet1").Select
    > 
    > 'count exceptions
    >    
    >     
    >     d = ActiveWorkbook.Worksheets("Exception List").Range("A1", Range("A1").End(xlDown)).Rows.Count
    >      
    >     'activate data base to filter   Sheets("1. Raw Data").Activate
    >       'count data base data ( a3 beacuse mine start at a3, use whatever you need)   F = ActiveWorkbook.Worksheets("1. Raw
    > Data").Range("A3", Range("A3").End(xlDown)).Rows.Count + 2   'loop for
    > each exception
    >   
    >     For i = 2 To d
    >     'exception loop taking
    >       Sheets("Exception List").Select
    >     Criteria1 = Range("a" & i).Value
    >     
    >     Sheets("1. Raw Data").Select
    >      'filter x exception in loop at data base
    >     ActiveSheet.Range("$A$3:$Z$" & F).AutoFilter Field:=5, Criteria1:= _
    >         Criteria1
    >       'down one of visible rows ( form header to first visible data)
    >       Range("a3").Select
    >        With Worksheets("1. Raw Data").AutoFilter.Range
    >          Range("a" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(3).Row).Select
    >           End With
    > 
    >        'select all data with exception
    >     Range(Selection, Selection.End(xlToRight).End(xlDown)).Select
    >         'erase exeptions
    >     Selection.delete Shift:=xlUp
    >     'erase filter
    >     ActiveSheet.Range("$A$3:$Z$3").AutoFilter Field:=5 'next exception
    >     Next i
    >     
    >     Application.ScreenUpdating = True
    >     
    >     
    >     'by christian marcos

清除所选范围内一行内的重复值

3 个答案: