- 帖子
- 2839
- 主題
- 10
- 精華
- 0
- 積分
- 2895
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2025-2-15
|
回復 8# greetingsfromtw
還是無法正常開啟檔案(格式太多), 大概猜著寫, 能自行更改最好:- Sub T_TEST()
- Dim Arr, i&, j%, xD, TK&, TM&, N&
- Arr = Range("A2:AD" & Cells(Rows.Count, 1).End(xlUp).Row)
- Set xD = CreateObject("Scripting.Dictionary")
- For i = 1 To UBound(Arr)
- If Arr(i, 3) = "" Then GoTo 101 'C欄不為空
- TK = "k" & Arr(i, 11): TM = "m" & Arr(i, 13) '數字各自冠上不同文字區別
- If xD(TK & TM) = 1 Then GoTo 101 '兩欄完全相同且已納入字典, 不處理
- If xD(TK) = 1 Then Arr(i, 11) = "": GoTo 999 'K值相同且非第一筆, 清空K值
- If xD(TM) = 1 Then Arr(i, 13) = "": GoTo 999 'M值相同且非第一筆, 清空M值
- 999: N = N + 1
- For j = 1 To UBound(Arr, 2): Arr(N, j) = Arr(i, j): Next '取得更新後的資料放在原陣列
- xD(TK & TM) = 1: xD(TK) = 1: xD(TM) = 1 '納入字典檔並冠上1為識別碼
- 101: Next i
- If N = 0 Then Exit Sub
- [A2:AD2].Resize(UBound(Arr)).Clear '清空原資料
- [A2:AD2].Resize(N) = Arr '填入更新資料
- End Sub
|
|
發表於 2016-10-18 10:28
| 