麻辣家族討論版版 - Powered by Discuz! Board

'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

複製代碼