去除A列同一学校中D列的重复项并保留一个值

wangmin111 · 发表于 2024-12-23 21:25

各位大神们，求如何去除A列同一内容中D列的重复项的代码，并保留唯一值

chxw68 · 发表于 2024-12-23 21:34

Sub test()
Dim r%, i%
Dim arr, brr
Dim rng As Range
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("蔬菜水果")
.AutoFilterMode = False
r = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Rows(r + 1)
arr = .Range("a1:f" & r)
For i = 2 To UBound(arr)
xm = arr(i, 1) & "+" & arr(i, 4)
If Not d.exists(xm) Then
d(xm) = i
Else
Set rng = Union(rng, .Rows(i))
End If
Next
rng.Delete
End With
End Sub

复制代码

chxw68 · 发表于 2024-12-23 21:34

参与一下。

gwjkkkkk · 发表于 2024-12-23 21:38

请图示操作一即可。。。

cnmlgb9998 · 发表于 2024-12-23 22:03

这样？？？？？？？？？？？

PQ 方案

quqiyuan · 发表于 2024-12-23 22:04

本帖最后由 quqiyuan 于 2024-12-23 22:06 编辑

这种需要vba 咯，仅供参考。。。
删除完提示删除了那些行

quqiyuan · 发表于 2024-12-23 22:07

代码如下。。。
Sub test()
Dim wb As Workbook, sht As Worksheet, rng As Range
Set wb = ThisWorkbook
Set sht = wb.Sheets("蔬菜水果")
arr = sht.[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
      s = arr(i, 1) & arr(i, 4)
      If Not d.exists(s) Then
         d(s) = i
      Else
         If rng Is Nothing Then
            Set rng = sht.Rows(i)
            xx = i
         Else
            Set rng = Union(rng, sht.Rows(i))
            xx = xx & "," & i
         End If
      End If
Next
rng.Delete
Set d = Nothing
MsgBox "删除的行有：" & xx
End Sub

lizhipei78 · 发表于 2024-12-23 22:32

本帖最后由 lizhipei78 于 2024-12-24 09:18 编辑

很简单的题目，JSA无聊写一个，没有技术含量

张小生 · 发表于 2024-12-23 23:16

详见附件，作为参考

wangmin111 · 发表于 2024-12-24 14:06

quqiyuan 发表于 2024-12-23 22:04
这种需要vba 咯，仅供参考。。。
删除完提示删除了那些行

老师，如果最后还想显示一共删除行的哈，代码该怎么调整呢

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

[求助] 去除A列同一学校中D列的重复项并保留一个值

评分

评分