這是一種方法 .

CODE (TRIED AND TESTED)

Option Explicit

Sub Sample()

Dim ws As Worksheet

Dim LastRow As Long, lastCol As Long, i as Long

Dim Rng As Range, aCell As Range

Dim MyCol As New Collection

'~~> Change this to the relevant sheet name

Set ws = Sheets("Sheet21")

With ws

LastRow = .Cells.Find(What:="*", After:=.Range("A1"), _

Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious, MatchCase:=False).Row

lastCol = .Cells.Find(What:="*", After:=.Range("A1"), _

Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious, MatchCase:=False).Column

Set Rng = .Range("A1:" & Split(.Cells(, lastCol).Address, "$")(1) & LastRow)

'Debug.Print Rng.Address

For Each aCell In Rng

If Not Len(Trim(aCell.Value)) = 0 Then

On Error Resume Next

MyCol.Add aCell.Value, """" & aCell.Value & """"

On Error GoTo 0

End If

Next

.Cells.ClearContents

For i = 1 To MyCol.Count

.Range("A" & i).Value = MyCol.Item(i)

Next i

'~~> OPTIONAL (In Case you want to sort the data)

.Columns(1).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

End With

End Sub

SNAPSHOTS

FOLLOWUP

我剛剛意識到添加3行更能使代碼比上面的代碼更快 .

Option Explicit

Sub Sample()

Dim ws As Worksheet

Dim LastRow As Long, lastCol As Long, i As Long

Dim Rng As Range, aCell As Range, delRange As Range '

Dim MyCol As New Collection

'~~> Change this to the relevant sheet name

Set ws = Sheets("Sheet1")

With ws

'~~> Get all the blank cells

Set delRange = .Cells.SpecialCells(xlCellTypeBlanks) '

'~~> Delete the blank cells

If Not delRange Is Nothing Then delRange.Delete '

LastRow = .Cells.Find(What:="*", After:=.Range("A1"), _

Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious, MatchCase:=False).Row

lastCol = .Cells.Find(What:="*", After:=.Range("A1"), _

Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious, MatchCase:=False).Column

Set Rng = .Range("A1:" & Split(.Cells(, lastCol).Address, "$")(1) & LastRow)

'Debug.Print Rng.Address

For Each aCell In Rng

If Not Len(Trim(aCell.Value)) = 0 Then

On Error Resume Next

MyCol.Add aCell.Value, """" & aCell.Value & """"

On Error GoTo 0

End If

Next

.Cells.ClearContents

For i = 1 To MyCol.Count

.Range("A" & i).Value = MyCol.Item(i)

Next i

'~~> OPTIONAL (In Case you want to sort the data)

.Columns(1).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

End With

End Sub

HTH

希德

總結

以上是生活随笔為你收集整理的Excel删除重复数据java_合并Excel范围中的数据，删除空白和重复项的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。