```
Sub ExtractUniqueData()
Dim wsSrc As Worksheet, wsDest As Worksheet
Dim lastRow As Long
Dim dict As Object, rng As Range, cell As Range
'設置源工作表和目標工作表
Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
Set wsDest = ThisWorkbook.Worksheets("Sheet2")
'確定源工作表最後壹行的行號
lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row
'定義創建字典對象
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextComp
are '不區分大小寫比較鍵值
'遍歷源工作表每壹行，將不重復的數據添加到字典中
For Each rng In wsSrc.Range("A1:A" & lastRow)
If Not IsEmpty(rng) Then
For Each cell In rng.Cells
If Not dict.exists(cell.Value) Then
dict.Item(cell.Value) = ""
End If
Next cell
End If
Next rng
'將字典中的不重復數據復制到目標工作表中
wsDest.Range("A1:A" & dict.Count) = Application.Transpose(dict.keys)
End Sub
```
在此示例中，我們假設源工作表中待提取數據所在的列為"A"列。首先，我們從工作簿中
獲取源工作表和目標工作表的對象。然後，使用`End(xlUp)`方法確定源工作表中最後壹行的行號。接下來，我們創建壹個字典對象，然後遍歷源工作表的每壹行，將不重復的數據添加到字典中。
在添加完所有不重復的數據後，我們可以將字典中的鍵值（即不重復的數據）復制到目標工作表的"A"列中。請註意，由於數組需要水平排列而字典中的鍵值是垂直排列，所以我們使用`Application.Transpose`函數將它們轉換為水平排列後再復制到目標工作表中。