- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
回復 18# aa7551 - Sub test()
- Dim ar, s5s6, s8s9, s, d1, d2
- Set d1 = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- With Sheets(1)
- ar = .Range(.[a2], .[a2].End(xlDown)).Value
- For Each s In ar
- s5s6 = Mid(s, 5, 2)
- If Mid(s, 4, 1) = "-" And (s5s6 = "11" Or s5s6 = "17" Or s5s6 = "20" Or s5s6 = "25" Or s5s6 = "37") Then d1.Item(s) = ""
-
- s8s9 = Mid(s, 8, 2)
- If Mid(s, 7, 1) = "-" And (s8s9 = "11" Or s8s9 = "20") Then d2.Item(s) = ""
- Next
- For Each s In d1.keys
- If Mid(s, 9, 1) = "R" And d1.exists(Left(s, 8) & "L" & Mid(s, 10)) Then
- d1.Remove (s)
- End If
- Next
- For Each s In d2.keys
- If Mid(s, 12, 1) = "R" And d2.exists(Left(s, 11) & "L" & Mid(s, 13)) Then
- d2.Remove (s)
- End If
- Next
-
- .[k2].Resize(d1.Count) = Application.Transpose(d1.keys)
- .[n2].Resize(d2.Count) = Application.Transpose(d2.keys)
- End With
- Set d1 = Nothing: Set d2 = Nothing
- End Sub
|
|
發表於 2013-1-18 22:29
| 
