删除重复列（多列）的VBA写法
Sub RemoveDuplicateRows()
Dim selectStartCloumnCount As Integer: selectStartCloumnCount = 0
Dim selectStartCloumn As String
Dim selectEndCloumnCount As Integer: selectEndCloumnCount = 0
Dim selectEndCloumn As String
Dim selectEndCloumnNM As String
Dim currenPoint As Integer: counter = 0
Dim sumCount As Integer
Dim Cols As Variant
Dim countTo As Integer
Dim wkSht As Worksheet
Dim objectSheet As Boolean
Dim wkName As String
wkName = ThisWorkbook.Name
For Each wkSht In Sheets
objectSheet = wkSht.Name Like "*データ"
If objectSheet Then
currenPoint = 0
selectEndCloumnCount = 0
selectStartCloumnCount = 0
RowCount = wkSht.Columns(2).Find("→", , , , , xlPrevious).Row
Set FoundCells = FindAll(wkSht)
If FoundCells Is Nothing Then
Debug.Print "nothing is found"
Else
sumCount = FoundCells.Cells.Count
For Each FoundCell In FoundCells.Cells
If currenPoint = 0 Then
selectStartCloumnCount = FoundCell.Column
selectStartCloumn = FoundCell.Address
Else
selectEndCloumnCount = FoundCell.Column - 1
selectEndCloumn = FoundCell.Address
selectEndCloumnNM = Num2Name(selectEndCloumnCount)
ReDim Cols(0 To selectEndCloumnCount - selectStartCloumnCount)
For I = 0 To UBound(Cols)
Cols(I) = I + 1
Next I
wkSht.Range(selectStartCloumn & ":" & selectEndCloumnNM & RowCount).RemoveDuplicates Columns:=(Cols), Header:=xlNo
selectStartCloumnCount = selectEndCloumnCount + 1
selectStartCloumn = selectEndCloumn
End If
currenPoint = currenPoint + 1
If currenPoint = sumCount Then
If wkName Like "*料金-請求*" Then
Set FoundCell = Cells(4, "AK")
Else
If wkName Like "*CRM*" Then
Set FoundCell = Cells(4, "AEH")
Else
Set FoundCell = Cells(4, "APR")
End If
End If
selectEndCloumnCount = FoundCell.Column
selectEndCloumnNM = Num2Name(selectEndCloumnCount)
ReDim Cols(0 To selectEndCloumnCount - selectStartCloumnCount)
For I = 0 To UBound(Cols)
Cols(I) = I + 1
Next I
wkSht.Range(selectStartCloumn & ":" & selectEndCloumnNM & RowCount).RemoveDuplicates Columns:=(Cols), Header:=xlNo
End If
Next FoundCell
End If
End If
Next wkSht
End Sub
Function FindAll(sheet As Worksheet)
Dim FoundCell As Range
Dim FoundCells As Range
Dim LastCell As Range
Dim FirstAddr As String
Dim SearchRange As Range
Dim FindWhat As Variant
Dim MatchCase As Boolean
Dim LookIn As XlFindLookIn
Dim LookAt As XlLookAt
Dim SearchOrder As XlSearchOrder
Set SearchRange = sheet.Range("B4").EntireRow
FindWhat = "→"
LookIn = xlValues
LookAt = xlWhole
SearchOrder = xlByRows
MatchCase = False
With SearchRange
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FoundCells = FoundCell
FirstAddr = FoundCell.Address
Do
Set FoundCells = Application.Union(FoundCells, FoundCell)
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
End If
If FoundCells Is Nothing Then
Set FindAll = Nothing
Else
Set FindAll = FoundCells
End If
End Function
Function Num2Name(ByVal ColumnNum As Long) As String
On Error Resume Next
Num2Name = ""
Num2Name = Replace(Cells(1, ColumnNum).Address(0, 0), "1", "")
End Function
