- 帖子
- 2798
- 主題
- 10
- 精華
- 0
- 積分
- 2854
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-4-20
|
- Sub TEST()
- Dim Arr, i&, j%, T$, xD, U&, N&
- Arr = Range([Sheet1!D1], [Sheet1!A1].Cells(Rows.Count, 1).End(xlUp))
- Set xD = CreateObject("Scripting.Dictionary")
- For i = 2 To UBound(Arr)
- T = Arr(i, 1) & Arr(i, 2): U = xD(T)
- If U = 0 Then
- N = N + 1: xD(T) = N: U = N
- For j = 1 To 4: Arr(U + 1, j) = Arr(i, j): Next
- End If
- Arr(U + 1, 4) = Arr(i, 4)
- Next i
- Sheets("Sheet2").UsedRange.EntireRow.Delete
- Sheets("Sheet2").[A1:D1].Resize(N + 1) = Arr
- End Sub
|
|
發表於 2018-4-30 21:32
| 