- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
2#
發表於 2014-3-19 15:55
| 只看該作者
本帖最後由 yen956 於 2014-3-19 15:57 編輯
回復 1# 013160
這是2003版, 你的是2007版, 應有更簡單版
但應仍可用, 試試看:
 - 'Sheet1
- Option Explicit
- '考慮到【編號】相當長(長達12位數),故用下拉式選單輸入【編號】
- Private Sub ComboBox1_Change()
- Dim sh1, sh2 As Object
- Dim i, endRow, cnt As Integer
- Set sh1 = Sheets("Sheet1")
- Set sh2 = Sheets("Sheet2")
- If ComboBox1 = "" Then Exit Sub
-
- '清除原有資料
- sh1.[B2].Resize(2000, 2) = ""
-
- '取得 編號 最後一列的列號
- endRow = sh2.[D2000].End(xlUp).Row
- cnt = 1
- For i = 2 To endRow
- If sh2.Cells(i, 4) = --ComboBox1 Then
- cnt = cnt + 1
- sh1.Cells(cnt, 2) = sh2.Cells(i, 1) '複製 頁數
- sh1.Cells(cnt, 3) = sh2.Cells(i, 6) '複製 餘數
- End If
- Next
- End Sub
- '
- 'Sheet2
- Option Explicit
- '如果 Sheet2 的【編號】有增減時,可點選 Sheet2,
- '用以觸動本程序, 進行資料重整
- Private Sub Worksheet_Activate()
- Dim i, endRow As Integer
-
- '2007版似可 將【篩選】與【排序】一併處理
- '可惜我的是 2003版, 只能分開處理
- '用【進階篩選】將【編號】篩選到 欄I, 並去除【重覆編號】
- Range("D1:D2000").AdvancedFilter Action:=xlFilterCopy, _
- CriteriaRange:=Range("D1:D2000"), _
- CopyToRange:=Range("I1"), Unique:=True
-
- endRow = [I2000].End(xlUp).Row
- '將篩選結果, 複製到 欄J
- [J1].Resize(2000, 1) = ""
- For i = 1 To endRow
- Cells(i, 10) = Cells(i, 9)
- Cells(i, 9) = ""
- Next
-
- '將 欄J 按升冪排序, 並將格式設為 "0000000000000"
- Range("J1:J2000").Sort Key1:=Range("J1"), _
- Order1:=xlAscending, Header:=xlYes
- Range("J1:J2000").NumberFormatLocal = "0000000000000"
-
- '重新定義 名稱 "x" 的範圍, 供 Sheet1 的 ComboBox1 用
- endRow = [J2000].End(xlUp).Row
- ActiveWorkbook.Names("x").Delete
- ActiveWorkbook.Names.Add Name:="x", _
- RefersToR1C1:="=Sheet2!R2C10:R" & endRow & "C10"
- End Sub
http://www.mediafire.com/download/4bw6wen76mga98f/輸入編號.7z |
|
