各位大大好：
小弟在multipage表單內，
其名稱為：年度所得暨扣繳金額明細表
其內設有一Listbox1供Combobox3及
Combobox5共用。
當選取Combobox3內的指定月份，
就能將指定資料顯示在Listbox1內，
且能將標頭欄顯示在正確位置內。
但當選取Combobox5時，同樣也能
顯示正確資料，但唯一的是其標頭欄
的位置會下移一列位置，不知其原因為
何呢？
語法如下：
Private Sub ComboBox5_Change()
Dim mDic1 As Scripting.Dictionary
Dim mDic2 As Scripting.Dictionary
Dim mDic3 As Scripting.Dictionary
Dim mDic4 As Scripting.Dictionary
Dim mDic5 As Scripting.Dictionary
Dim mDic6 As Scripting.Dictionary
Dim mDic7 As Scripting.Dictionary
Dim mDic8 As Scripting.Dictionary
Dim mDic9 As Scripting.Dictionary
Dim mKey1 As Variant
Dim mItem1 As Variant, mItem2 As Variant, mItem3 As Variant, mItem4 As Variant, mItem5 As Variant, mItem6 As Variant, mItem7 As Variant, mItem8 As Variant, mItem9 As Variant
Dim mRng6
Dim s6a%, s6b%, m6%, m6a%, m6b%, i6%, j6%, mRow6a%, mRow6b%
Dim mSht6 As Worksheet
Dim mRng6a As Range
Dim mStr6$, mTmp6$
Dim mSplit6
Dim mTotal6a As Long, mTotal6b As Long, mQty6 As Integer
Set mDic1 = CreateObject("scripting.dictionary")
Set mDic2 = CreateObject("scripting.dictionary")
Set mDic3 = CreateObject("scripting.dictionary")
Set mDic4 = CreateObject("scripting.dictionary")
Set mDic5 = CreateObject("scripting.dictionary")
Set mDic6 = CreateObject("scripting.dictionary")
Set mDic7 = CreateObject("scripting.dictionary")
Set mDic8 = CreateObject("scripting.dictionary")
Set mDic9 = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
With ListBox1
.RowSource = ""
End With
Set mSht6 = Worksheets("年度所得暨扣繳金額明細表")
With mSht6
With ComboBox5
.Value = .List(.ListIndex)
mTmp = .Value
End With
'mTmp = "100"
For i6 = 4 To .[a65536].End(xlUp).Row
mSplit6 = Split(.Cells(i6, 1), ".")
If mSplit6(0) = mTmp Then
mRow6a = i6
Exit For
End If
Next
For j6 = .[a65536].End(xlUp).Row To 4 Step -1
mSplit6 = Split(.Cells(j6, 1), ".")
If mSplit6(0) = mTmp Then
mRow6b = j6
Exit For
End If
Next
mRng6 = .Range("a" & mRow6a & ":" & "l" & mRow6b)
m6a = UBound(mRng6, 1)
m6b = UBound(mRng6, 2)
For s6a = 1 To UBound(mRng6, 1)
mDic1(mRng6(s6a, 3)) = mDic1(mRng6(s6a, 3)) + mRng6(s6a, 12)
mDic2(mRng6(s6a, 2) & "_" & mRng6(s6a, 3)) = mDic2(mRng6(s6a, 2) & "_" & mRng6(s6a, 3)) + mRng6(s6a, 11)
mDic3(mRng6(s6a, 3)) = mDic3(mRng6(s6a, 3)) + mRng6(s6a, 10)
mDic4(mRng6(s6a, 3)) = mDic4(mRng6(s6a, 3)) + mRng6(s6a, 9)
mDic5(mRng6(s6a, 3)) = mDic5(mRng6(s6a, 3)) + mRng6(s6a, 8)
mDic6(mRng6(s6a, 3)) = mDic6(mRng6(s6a, 3)) + mRng6(s6a, 7)
mDic7(mRng6(s6a, 3)) = mDic7(mRng6(s6a, 3)) + mRng6(s6a, 6)
mDic8(mRng6(s6a, 3)) = mDic8(mRng6(s6a, 3)) + mRng6(s6a, 5)
mDic9(mRng6(s6a, 3)) = mDic9(mRng6(s6a, 3)) + mRng6(s6a, 4)
Next
mKey1 = mDic1.Keys
mKey2 = mDic2.Keys
mItem1 = mDic1.Items
mItem2 = mDic2.Items
mItem3 = mDic3.Items
mItem4 = mDic4.Items
mItem5 = mDic5.Items
mItem6 = mDic6.Items
mItem7 = mDic7.Items
mItem8 = mDic8.Items
mItem9 = mDic9.Items
mQty6 = mDic1.Count
.Range("p4").CurrentRegion = ""
.Columns("p:q").NumberFormatLocal = "@"
.Range("r4:z" & mQty6 + 4).NumberFormatLocal = "#,##0"
m6 = 4
For s6b = 0 To mDic1.Count - 1
mTotal6a = mTotal6a + mItem1(s6b)
mTotal6b = mTotal6b + mItem4(s6b)
mSplit6 = Split(mKey2(s6b), "_")
If mKey1(s6b) = mSplit6(1) Then
.Cells(m6, 16) = mSplit6(0)
.Cells(m6, 17) = mSplit6(1)
Else
.Cells(m6, 17) = mKey2(s6b)
End If
.Cells(m6, 18) = mItem9(s6b)
.Cells(m6, 19) = mItem8(s6b)
.Cells(m6, 20) = mItem7(s6b)
.Cells(m6, 21) = mItem6(s6b)
.Cells(m6, 22) = mItem5(s6b)
.Cells(m6, 23) = mItem4(s6b)
.Cells(m6, 24) = mItem3(s6b)
.Cells(m6, 25) = mItem2(s6b)
.Cells(m6, 26) = mItem1(s6b)
m6 = m6 + 1
Next
TextBox58.Value = Format(mTotal6a, "#,##0")
TextBox59.Value = Format(mTotal6b, "#,##0")
TextBox60.Value = mQty6
.Range("b3:l3").Copy Destination:=.Range("p3")
.Columns("p:z").AutoFit
Set mRng6a = .Range("p4").CurrentRegion
'MsgBox mRng6c.Address
With Application.Names.Add("mTmp6", RefersTo:=mRng6a)
mStr6 = .RefersTo
.Delete
End With
With ListBox1
.Width = .Width * 1
.ColumnCount = 11
.RowSource = mStr6
'.RowSource = mRng6a.Address(, , , 1, 1)
.ColumnHeads = True
'.List = mRng6r
End With
End With
Set mSht6 = Nothing
Set dic1 = Nothing
Set dic2 = Nothing
Set dic3 = Nothing
Set dic4 = Nothing
Set dic5 = Nothing
Set dic6 = Nothing
Set dic7 = Nothing
Set dic8 = Nothing
Set dic9 = Nothing
End Sub |
發表於 2010-10-17 07:53
| 
發表於 2010-10-17 10:33
| 