麻烦写个VBA找出列1里面相同的数据的位置！

sunya_0529 · 发表于 2025-3-25 19:37

gloluking 发表于 2025-3-25 19:19
先感谢先，不过有两个问题，可以修改下吗？
1.5个数据，漏了最前的62，只出现4个
2.能不能最后判断列5 ...

自动筛选也得留个标题行呀，所以第一行插入一行，再执行宏吧。

gloluking · 发表于 2025-3-25 20:03

sunya_0529 发表于 2025-3-25 19:37
自动筛选也得留个标题行呀，所以第一行插入一行，再执行宏吧。

知道了，麻烦修改下排序连续再加红底

gwjkkkkk · 发表于 2025-3-25 21:25

gwjkkkkk · 发表于 2025-3-25 22:18

请参考附件。。。

gloluking · 发表于 2025-3-25 22:46

gwjkkkkk 发表于 2025-3-25 22:18
请参考附件。。。

可以，感谢了，这就是我想要的

sunya_0529 · 发表于 2025-3-25 22:47

gloluking 发表于 2025-3-25 20:03
知道了，麻烦修改下排序连续再加红底

Option Explicit
Sub 筛选数据()
On Error Resume Next '忽略错误
Application.ScreenUpdating = False '关闭屏幕更新
Dim arr As Variant
Dim dic As Object
Dim rng As Range
Dim brr As Variant
Dim i As Integer
Dim j As Integer
arr = Application.Transpose(Range(Cells(2, 2), Cells(2, 2).End(xlDown)).Value2) '获取B列数据存入数组
Set dic = CreateObject("Scripting.Dictionary") '创建字典对象
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False '关闭自动筛选
.Columns(1).AutoFilter field:=1, Criteria1:=arr, Operator:=xlFilterValues '根据B列数据在A列筛选数据
For Each rng In .Cells(2, 5).CurrentRegion.SpecialCells(xlCellTypeVisible) '在第5列遍历筛选出的单元格
dic.Add rng.Address, rng.Value '将筛选出的单元格地址和值存入字典对象
Next rng
brr = dic.keys '获取字典对象的键值
.Columns(5).ClearFormats '清除第5列格式
For i = 1 To UBound(brr) '遍历字典对象的键值
If dic(brr(i)) - dic(brr(i - 1)) = 1 Or dic(brr(i + 1)) - dic(brr(i)) = 1 Then '判断是否连续
Range(brr(i)).Interior.ThemeColor = 6 '设置连续单元格颜色
Range(brr(i)).Font.Color = vbWhite '设置连续单元格字体颜色
End If
Next i
End With
Set dic = Nothing '释放字典对象
Application.ScreenUpdating = True '恢复屏幕更新
End Sub

复制代码

gloluking · 发表于 2025-3-26 08:13

sunya_0529 发表于 2025-3-25 22:47

麻烦了，但是gwjkkkkk的VBA比较符合我的要求，列1的数据不会因为VBA而改变，
我主要是看看相同的数据在什么年份，不需要选出来

gloluking · 发表于 2025-3-26 11:27

gwjkkkkk 发表于 2025-3-25 22:18
请参考附件。。。

有个小问题，麻烦帮我修改下，列2那我要是从别的表格拉数据代替，VBA没反应，
在别的表格，列2输入数据，VBA也没反应
在列1复制数据到列2，倒是没问题
麻烦把VBA搞成文字，别图片，谢谢

用户名		自动登录	找回密码
密码			免费注册

[求助] 麻烦写个VBA找出列1里面相同的数据的位置！