
你有两个地方产生了重复比较, 一是循环上内外层循环有重复的地方, 二是即使循环不重复, 如果同一个值出现了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工作表中同一列下的相同项等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!
欢迎分享,转载请注明来源:内存溢出
微信扫一扫
支付宝扫一扫
评论列表(0条)