欢迎光临

木子屋

标题: Excel 2000 同一工作表查重(支持多列查重)

作者: dnawo

日期: 2009-03-02 10:46 PM

分类: 操作系统

内容: 在Access、mssql中可以使用SQL语句进行查重，但在Excel中就没那么容易了，查找了Excel相关资料后，写了个VBA函数(宏)来实现：
复制内容到剪贴板 程序代码'---------------------------------------------------------------
' 功能：对指定列进行查重，并标红或删除重复行
' 作者：dnawo
' web：http://www.mzwu.com/
' 时间：2009-03-02
'---------------------------------------------------------------
Option Explicit
Sub 查重()
Dim columns As String '要查重的列
Dim columnsList() As String '要查重的列数组
Dim delrows As String '要删除的行,格式: |10|11|14|20|
Dim delrowsList() As String '要删除的行数组
Dim isDouble As Boolean
Dim i, j, k As Integer

columns = InputBox("请输入要查重的列数(第一列为1,第二列为2)，如1,2,3", "列数：", "1")
delrows = "|"

If columns <> "" Then
columnsList = Split(columns, ",")

'列格式验证
For i = 0 To UBound(columnsList)
If Not IsNumeric(columnsList(i)) Then
MsgBox "列数应为数字！错误的列数：" & columnsList(i), vbOKOnly, "出错："
Exit Sub
End If
Next

'判断并获取重复的行索引
For i = 1 To ActiveSheet.UsedRange.Rows.count
'已判定重复的行不再次进行判断,下同
If InStr(delrows, "|" & CStr(i) & "|") = 0 Then
For j = i + 1 To ActiveSheet.UsedRange.Rows.count
If InStr(delrows, "|" & CStr(j) & "|") = 0 Then
'查重
isDouble = True
For k = 0 To UBound(columnsList)
If Cells(i, CInt(columnsList(k))) <> Cells(j, CInt(columnsList(k))) Then
isDouble = False
Exit For
End If
Next

'记录重复行
If isDouble Then
delrows = delrows & CStr(j) & "|"
End If
End If
Next
End If
Next

'处理重复行
If delrows <> "|" Then
delrowsList = Split(Mid(delrows, 2, Len(delrows) - 2), "|")

'delrowsList从大到小排序方便下边删除重复行
Dim tmp As String
For i = 0 To UBound(delrowsList)
For j = i + 1 To UBound(delrowsList)
If CInt(delrowsList(i)) < CInt(delrowsList(j)) Then
tmp = delrowsList(i)
delrowsList(i) = delrowsList(j)
delrowsList(j) = tmp
End If
Next
Next

'重复行处理:标红或删除
For i = 0 To UBound(delrowsList)
Cells.Rows(CInt(delrowsList(i))).Font.Color = vbRed '标红
'Cells.Rows(CInt(delrowsList(i))).Delete '删除
Next
End If

MsgBox "查重结束！", vbOKOnly, "提示："
Else
MsgBox "没有输入要查重的列数！", vbOKOnly, "出错："
End If
End Sub
使用方法：在宏管理菜单中输入宏名字"查重"，点击创建按钮后粘贴上边代码保存即可。

+ 查看当前日志评论 (0)

登录

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 1.129 ms

返回

标题: Excel 2000 同一工作表查重(支持多列查重)

你没有权限发表评论

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 1.129 ms

返回

暂无评论

返回

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 1.145 ms

返回