【實例12-去除重復(fù)】Excel表格VBA編程實例 代碼分享
Private Sub CommandButton去除重復(fù)_Click()
'清除處理結(jié)果數(shù)據(jù)
With ThisWorkbook.Worksheets("處理結(jié)果")
? ? .UsedRange.ClearFormats
? ? .UsedRange.ClearContents
End With
'判斷輸入了區(qū)域參數(shù)
With ThisWorkbook.Worksheets("操作界面")
? ? ?If Trim(.Cells(2, "C").Value) = "" Then
? ? ?MsgBox "參數(shù)不能為空"
? ? ?Exit Sub
? ? ?End If
On Error GoTo 處理出錯
'定義變量
Dim filterrange As String
filterrange = Trim(.Cells(2, "C").Value)
End With
'循環(huán)篩選，添加到數(shù)組，重復(fù)的不添加
Dim item_array() As String
Dim item_count As Long
With ThisWorkbook.Worksheets("原數(shù)據(jù)")
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
'顯示數(shù)組中的結(jié)果（非重復(fù)數(shù)據(jù)）
If item_count > 0 Then
With ThisWorkbook.Worksheets("處理結(jié)果")
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? '檢查數(shù)組是否有指定值
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
