- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2018-9-6 16:46
| 只看該作者
回復 3# sunshine010
試試看- Option Explicit
- Sub Ex()
- Dim Rng(1 To 2), Sh As Worksheet, i As Integer, E As Variant
- Set Sh = Workbooks.Add(1).Sheets(1) '所新增活頁簿的第一張工作表
- For i = 2 To 33
- Set Rng(1) = Sheets(i).Range("B4:AG65536")
- Set Rng(2) = Sh.Range(Rng(1).Address)
- With Rng(2)
- .Clear
- .Value = Rng(1).Value '複製Rng(1)
- End With
- For Each E In Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33)
- Rng(1).Columns(E).AdvancedFilter xlFilterCopy, "", Rng(2).Cells(E), True
- '每一欄的 進階篩選 不重複的值 到 Rng(2)的每一欄
- Next
- Rng(1).Value = Rng(2).Value
- Next
- Sh.Parent.Close False '關閉新增活頁簿
- End Sub
複製代碼 |
|