- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 61
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-3-12
               
|
回復 7# freeffly - Sub ex()
- Set d = CreateObject("Scripting.Dictionary")
- For Each a In Range([A2], [A65536].End(xlUp))
- m = a & a.Offset(, 2) & Split(a.Offset(, 3), "-")(1) '串接A、C欄與D欄的日期部分字串
- If IsEmpty(d(m)) Then '當字典以m為索引的內容初始化時執行
- d(m) = Array(1, a.Offset(, 5)) '將A欄與F欄為陣列賦給m為索引的內容
-
- Else '當出現第二個以上的m
- ar = d(m) '取出字典內容
- If ar(1) <> a.Offset(, 5) Then '當陣列第二個元素值與F欄不同
- ar(0) = ar(0) + 1 '陣列第一個值加一，當成同索引且單價不同的計數
- d(m) = ar '將陣列回存到字典
- End If
- Erase ar '清除陣列
- End If
- Next
- For Each ky In d.keys
- If d(ky)(0) = 1 Then d.Remove ky '如果字典內容第一個項目是1，也就是單一計數就移除該索引內容
- Next
- For Each a In Range([A2], [A65536].End(xlUp))
- m = a & a.Offset(, 2) & Split(a.Offset(, 3), "-")(1)
- i = Application.Match(m, d.keys, 0) '取得該字串是字典第幾個項目
- If IsNumeric(i) Then
- a.Offset(, 6) = "A" & i '寫入編號
- Else
- a.Offset(, 6) = "" '不字典內就清空G欄
- End If
- Next
- End Sub
|
|
發表於 2012-5-8 21:08
| 
