【实例12-去除重复】Excel表格VBA编程实例 代码分享
Private Sub CommandButton去除重复_Click()
'清除处理结果数据
With ThisWorkbook.Worksheets("处理结果")
.UsedRange.ClearFormats
.UsedRange.ClearContents
End With
'判断输入了区域参数
With ThisWorkbook.Worksheets("操作界面")
If Trim(.Cells(2, "C").Value) = "" Then
MsgBox "参数不能为空"
Exit Sub
End If
On Error GoTo 处理出错
'定义变量
Dim filterrange As String
filterrange = Trim(.Cells(2, "C").Value)
End With
'循环筛选，添加到数组，重复的不添加
Dim item_array() As String
Dim item_count As Long
With ThisWorkbook.Worksheets("原数据")
Dim itemcell
For Each itemcell In .Range(filterrange)
If itemcell <> "" Then
If item_count = 0 Then
ReDim Preserve item_array(item_count)
item_array(item_count) = itemcell.Value
item_count = item_count + 1
Else
If checkrepeatarrayfun(item_array, itemcell.Value) = False Then
ReDim Preserve item_array(item_count)
item_array(item_count) = itemcell.Value
item_count = item_count + 1
End If
End If
End If
Next
End With
'显示数组中的结果（非重复数据）
If item_count > 0 Then
With ThisWorkbook.Worksheets("处理结果")
Dim i
For i = 0 To UBound(item_array)
.Cells(i + 1, 1).Value = item_array(i)
Next i
.Activate
.Cells(1, 1).Select
End With
End If
Exit Sub
处理出错:
MsgBox Err.Description
End Sub
Function checkrepeatarrayfun(ByVal checkarray, ByVal checkdata) As Boolean '检查数组是否有指定值
On Error GoTo checkerror
checkrepeatarrayfun = False
If IsArray(checkarray) = True Then
Dim check_i
For check_i = 0 To UBound(checkarray)
If checkarray(check_i) = checkdata Then
checkrepeatarrayfun = True
Exit Function
End If
Next check_i
End If
checkerror:
checkrepeatarrayfun = False
End Function
