- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2010-6-10 07:17 編輯
回復 3# myleoyes- Sub 比對備份()
- Dim d As Object, Rng As Range, E As Range, M%, R, i%
- Set d = CreateObject("Scripting.Dictionary")
- With Sheets("比對備份")
- If .Range("iv1").End(xlToLeft).Column > 1 Then '已有備份資料
- Set Rng = .Range("B1", .Range("iv1").End(xlToLeft)) '備份資料欄位範圍
- Set E = Rng(1, Rng.Columns.Count + 1) '設立要加入備份資料欄位的位置
- M = Application.Max(Rng) '取得已有備份資料中第1列內相同項目的最大數
- Else '沒有備份資料
- Set E = .Range("B1")
- M = 0
- End If
- End With
- Set Rng = Range("A1").CurrentRegion
- Set Rng = Range("C1", Rng(Rng.Rows.Count, Rng.Columns.Count)) '備份資料的範圍
- i = 1
- For Each R In Rng.Rows(1).Cells
- If Not d.Exists(R.Value) Then
- d(R.Value) = i '設定複製資料內第1列相同項目的數值
- i = i + 1
- End If
- Next
- Rng.Copy E
- i = 0
- Do While E.Offset(, i) <> ""
- If d.Exists(E.Offset(, i).Value) Then E.Offset(, i) = d(E.Offset(, i).Value) + M
- '修改複製資料後 第1列相同項目新增的數值
- '->設定複製資料內第1列相同項目的數值 + 已有備份資料中第1列內相同項目的最大數
- i = i + 1
- Loop
- End Sub
|
|
發表於 2010-6-9 17:15
| 
發表於 2010-6-9 08:20
| 
