excel 仅清除相邻的重复项

oxiaedzo 于 2023-01-03 发布在其他

关注(0)|答案(2)|浏览(247)

此子函数清除两列之间的重复行。
如果它在列F和G中找到新的对，它将在整个F和G中清除该对。
我正在尝试清除直接低于原始值的值。
我尝试在清除重复项后进行重置，这样它就不会清除不直接低于原始值的值。

Sub clearDups1()

    Dim lngMyRow As Long
    Dim lngMyCol As Long
    Dim lngLastRow As Long
    Dim objMyUniqueData As Object
   
    Application.ScreenUpdating = False

    lngLastRow = Range("F:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
   
    Set objMyUniqueData = CreateObject("Scripting.Dictionary")
   
    For lngMyRow = 1 To lngLastRow 'Assumes the data starts at row 1. Change to suit if necessary.
        If objMyUniqueData.Exists(CStr(Cells(lngMyRow, 6) & Cells(lngMyRow, 7))) = False Then
            objMyUniqueData.Add CStr(Cells(lngMyRow, 6) & Cells(lngMyRow, 7)), Cells(lngMyRow, 6) & Cells(lngMyRow, 7)
        Else
            Range(Cells(lngMyRow, 6), Cells(lngMyRow, 7)).ClearContents
        End If
    Next lngMyRow
   
    Set objMyUniqueData = Nothing
   
    Application.ScreenUpdating = True
   
End Sub

任何意见都欢迎。

excel

来源：https://stackoverflow.com/questions/73531661/clear-adjacent-duplicates-only

2条答案

按热度按时间

k3bvogb11#

你不需要一本字典：

Sub clearDups1()

    Dim lngMyRow As Long, lngLastRow As Long, ws As Worksheet
    Dim k As String, kPrev As String
    
    Set ws = ActiveSheet
    lngLastRow = ws.Range("F:G").Find("*", SearchOrder:=xlByRows, _
                                      SearchDirection:=xlPrevious).row
   
    Application.ScreenUpdating = False
    kPrev = Chr(0) 'won't occur in your data
    For lngMyRow = 1 To lngLastRow 'Assumes the data starts at row 1. Change to suit if necessary.
        k = CStr(ws.Cells(lngMyRow, 6).Value) & "<>" & CStr(ws.Cells(lngMyRow, 7).Value)
        If kCurr = k Then 'same as previous row?
            ws.Cells(lngMyRow, 6).Resize(1, 2).ClearContents
        End If
        kPrev = k 'set as key for previous row
    Next lngMyRow
    Application.ScreenUpdating = True
End Sub

赞(0）回复(0）举报 2023-01-03

jslywgbw2#

你也可以试试这个代码，它能完成你的要求。
1.保留第一次发生的相同重复
1.从底部开始删除它们，并留下最后，在我们的情况下将是原始的
使用上述方法你可以达到你所要求的。

Sub clearDups() 
    Dim lR As Long, r As Long 
    Dim x As 99999 
    Dim f(x), g(x) As String 
    Dim lRow As Long, lCol As Long, i As Long 
    lRow = Range("F" & Rows.Count).End(xlUp).Row 
    For lR = 2 To lRow 
        f(lR - 1) = Cells(lR, "F").Value 
        g(lR - 1) = Cells(lR, "G").Value 
    Next 
    For Each s In f 
        i = i + 1 
        If Application.CountIf(Range("F1:G" & lRow), s) = 2 Then 
            Cells(i, "F").Value = "" 
            Cells(i, "G").Value = "" 
        End If 
    Next 
End Sub

赞(0）回复(0）举报 2023-01-03

我来回答

excel 仅清除相邻的重复项

2条答案

相关问题

热门标签

最新问答