重复单元格加上行号

hcy1185

查找重复加行号.rar (20.51 KB, 下载次数: 15)

2018-9-18 11:34 上传

点击文件名下载附件

chxw68

也没有模拟结果或示例，不知道行号怎么加呢。

一把小刀闯天下

'猜一个

Option Explicit

Sub test()
  Dim arr, i, dic, m
  Set dic = CreateObject("scripting.dictionary")
  arr = Range("b7:b" & Cells(Rows.Count, "b").End(xlUp).Row)
  For i = 1 To UBound(arr, 1): dic(arr(i, 1)) = dic(arr(i, 1)) + 1: Next
  For i = 1 To UBound(arr, 1)
    If dic(arr(i, 1)) > 1 Then
      m = m + 1: arr(i, 1) = m
    Else
      arr(i, 1) = vbNullString
    End If
  Next
  [a7].Resize(UBound(arr, 1)) = arr
End Sub

hcy1185

chxw68 发表于 2018-9-18 11:42
也没有模拟结果或示例，不知道行号怎么加呢。

行号加在重复单元格内容的后面

hcy1185

一把小刀闯天下 发表于 2018-9-18 11:51
'猜一个

Option Explicit

你好！把重复内容的后面加上本身所在的行号

一把小刀闯天下

hcy1185 发表于 2018-9-18 11:54
你好！把重复内容的后面加上本身所在的行号

Option Explicit

Sub test()
  Dim arr, i, dic
  Set dic = CreateObject("scripting.dictionary")
  arr = Range("b7:b" & Cells(Rows.Count, "b").End(xlUp).Row)
  For i = 1 To UBound(arr, 1): dic(arr(i, 1)) = dic(arr(i, 1)) + 1: Next
  For i = 1 To UBound(arr, 1)
    arr(i, 1) = IIf(dic(arr(i, 1)) > 1, i + 6, vbNullString)
  Next
  [a7].Resize(UBound(arr, 1)) = arr
End Sub

hcy1185

一把小刀闯天下 发表于 2018-9-18 11:59
Option Explicit

Sub test()

不是加在a列，加在b列内容的后面，再运行代码就没有重复单元格啦

一把小刀闯天下

hcy1185 发表于 2018-9-18 12:14
不是加在a列，加在b列内容的后面，再运行代码就没有重复单元格啦

'发了242个主题这都不会修改，厉害

Option Explicit

Sub test()
  Dim arr, i, dic
  Set dic = CreateObject("scripting.dictionary")
  arr = Range("b7:b" & Cells(Rows.Count, "b").End(xlUp).Row)
  For i = 1 To UBound(arr, 1): dic(arr(i, 1)) = dic(arr(i, 1)) + 1: Next
  For i = 1 To UBound(arr, 1)
    If dic(arr(i, 1)) > 1 Then arr(i, 1) = arr(i, 1) & (i + 6)
  Next
  [b7].Resize(UBound(arr, 1)) = arr
End Sub

hcy1185

一把小刀闯天下 发表于 2018-9-18 12:21
'发了242个主题这都不会修改，厉害

Option Explicit

如果能在每句代码后面加上注释就好了，好学习一下，谢谢！！

一把小刀闯天下

hcy1185 发表于 2018-9-18 12:25
如果能在每句代码后面加上注释就好了，好学习一下，谢谢！！

Option Explicit

Sub test()
  Dim arr, i, dic
  Set dic = CreateObject("scripting.dictionary") '创建字典
  arr = Range("b7:b" & Cells(Rows.Count, "b").End(xlUp).Row)
  '从[b7]开始取当前列有数据的最大行数据区放入数组,仅取b列中的数据
  For i = 1 To UBound(arr, 1): dic(arr(i, 1)) = dic(arr(i, 1)) + 1: Next
  '数组中的数据写入字典，单个数据每重复一次+1
  For i = 1 To UBound(arr, 1)
    If dic(arr(i, 1)) > 1 Then arr(i, 1) = arr(i, 1) & (i + 6)
    '如果数组中的当前数据在字典中出现过不止1次，在数据后加入行号（因为数组从[b7]开始取数据，所以写入行号时要+6）
  Next
  [b7].Resize(UBound(arr, 1)) = arr '重写一遍数据到工作表，所以还是从[b7]写入
End Sub