VBA计算某列的数据内容是否重复,计算出错求帮助~~

VBA计算某列的数据内容是否重复,计算出错求帮助~~,第1张

你有两个地方产生了重复比较, 一是循环上内外层循环有重复的地方, 二是即使循环不重复, 如果同一个值出现了3次以上也会造成重复 所以必须要有数组来记录每行是否重复的状态

以下是我的方法:

Sub GetRepeatCount()

    Dim maxRow As Long, maxCol As Long

    Dim i As Long, j As Long

    Dim tempRange As Range

    Dim targetRecord, currentRecord

    Dim totalCount As Long, totalRepeatCount As Long

    Dim repeatCount As Long     '某一条记录重复的次数

    Dim recordRepeatCount As Long '结果没用到,但我还是将它计算出来, 部分情况需要知道这个值

    Dim isRepeat() As Long

    With Range("A1")CurrentRegion

        maxRow = RowsCount

        maxCol = ColumnsCount

        Offset(1)InteriorPattern = xlNone

    End With

    

    '记录数小于2时无需比较

    totalCount = maxRow - 1

    If totalCount < 2 Then

        If totalCount < 0 Then

            totalCount = 0

        End If

        totalRepeatCount = 0

        MsgBox "记录总数=" & totalCount & ", 唯一数=" & totalCount & ", 重复数=0"

    End If

    

    ReDim isRepeat(totalCount) As Long    '此数组记录每个记录的与那个记录重复(选取记录第一次出现的行号)

    Set tempRange = Range(Cells(1, 1), Cells(1, maxCol))    '标题行

    For i = 1 To totalCount - 1

        targetRecord = GroupCell(tempRangeOffset(i))

        repeatCount = 0

        If isRepeat(i) = 0 Then     'isRepeat数组记录此行的重复状态, 如果此行已经被标记重复了就不再 *** 作

            For j = i + 1 To totalCount

                currentRecord = GroupCell(tempRangeOffset(j))

                If currentRecord = targetRecord Then

                    repeatCount = repeatCount + 1

                    isRepeat(j) = i + 1     '当前比较的记录发生重复的次数

                    tempRangeOffset(j)InteriorColor = RGB(200, 80, 80)

                End If

            Next j

        End If

        If repeatCount > 0 Then

            recordRepeatCount = recordRepeatCount + 1   '有重复情况的记录的个数

        End If

        totalRepeatCount = totalRepeatCount + repeatCount '所有记录发生重复的次数

    Next i

    MsgBox "记录总数:" & totalCount & vbLf & _

        "唯一记录数:" & totalCount - totalRepeatCount & vbLf & _

        "重复记录数:" & totalRepeatCount

End Sub

'将一行数据组合起来比较

Function GroupCell(myRange As Range) As String

    Dim cell As Range

    For Each cell In myRange

        GroupCell = GroupCell & cell

    Next cell

End Function

Sub 重复判断()

Dim i, j, k, n As Integer

Dim t, t1

i = 1

n = 1

Do While Cells(i, 3) <> "" '如果单元格,不为空,进入循环,注意C列不能右空单元格

t = Cells(i, 3) '取出C列单元格

j = Sheet1Range("a65536")End(xlUp)Row '取出A最大非空单元格

For k = 1 To j '取出A列单元格,比例C列单元格数据,是否等于A列单元格

t1 = Cells(k, 1)

If t = t1 Then

Cells(n, 2) = t1 '如果重复,则对B列单元格赋值

End If

Next

If Cells(n, 2) = "" Then '上面只是判断是否重复,并输入了重复单元格,不重复,单元格就是空的

Cells(n, 2) = "不重复"

End If

n = n + 1

i = i + 1

Loop

End Sub

小白乱写的

你要找相同的可用一楼的办法,如果想只保留一个记录,即去掉重复的记录,可用高级筛选,选中B列,数据--筛选--高级筛选,条件区域为:$B:$B,复制到:填你要复制到的区域,点选:筛选不重复的记录,确定就行了

Sub s()

    Set d = CreateObject("scriptingdictionary")

    c = InputBox("请输入列标:")

    n = Cells(RowsCount, c)End(3)Row

    For i = 1 To n

        a = Cells(i, c)Text

        If a <> "" Then

            If dexists(a) Then

                MsgBox c & "列内容有重复!"

                Exit Sub

            Else

                dAdd a, ""

            End If

        End If

    Next

    MsgBox c & "列内容无重复!"

End Sub

以上就是关于VBA计算某列的数据内容是否重复,计算出错求帮助~~全部的内容,包括:VBA计算某列的数据内容是否重复,计算出错求帮助~~、求助!请高手赐教,我需要用一个VBA代码实现两列数据查重、利用VBA筛选EXCEL工作表中同一列下的相同项等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

欢迎分享,转载请注明来源:内存溢出

原文地址:https://54852.com/web/9806544.html

(0)
打赏 微信扫一扫微信扫一扫 支付宝扫一扫支付宝扫一扫
上一篇 2023-05-02
下一篇2023-05-02

发表评论

登录后才能评论

评论列表(0条)

    保存