ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ListboxÅã¥Ü¸ê®Æ®É¨ä¼ÐÀYÄæ¦ì¸m·|¤U²¾¤@¦C©O¡H

[µo°Ý] ListboxÅã¥Ü¸ê®Æ®É¨ä¼ÐÀYÄæ¦ì¸m·|¤U²¾¤@¦C©O¡H

¦U¦ì¤j¤j¦n¡G

  ¤p§Ì¦bmultipageªí³æ¤º¡A
¨ä¦WºÙ¬°¡G¦~«×©Ò±oº[¦©Ãºª÷ÃB©ú²Óªí
¨ä¤º³]¦³¤@Listbox1¨ÑCombobox3¤Î
Combobox5¦@¥Î¡C

  ·í¿ï¨úCombobox3¤ºªº«ü©w¤ë¥÷¡A
´N¯à±N«ü©w¸ê®ÆÅã¥Ü¦bListbox1¤º¡A
¥B¯à±N¼ÐÀYÄæÅã¥Ü¦b¥¿½T¦ì¸m¤º¡C

   ¦ý·í¿ï¨úCombobox5®É¡A¦P¼Ë¤]¯à
Åã¥Ü¥¿½T¸ê®Æ¡A¦ý°ß¤@ªº¬O¨ä¼ÐÀYÄæ
ªº¦ì¸m·|¤U²¾¤@¦C¦ì¸m¡A¤£ª¾¨ä­ì¦]¬°
¦ó©O¡H

»yªk¦p¤U¡G

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("¦~«×©Ò±oº[¦©Ãºª÷ÃB©ú²Óªí")
    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

YEARTotal.rar (67.64 KB)

¥»©«³Ì«á¥Ñ GBKEE ©ó 2010-10-17 10:35 ½s¿è

¦^´_ 1# dechiuan999
³]©w list.ColumnHeads = True ®ÉªíÀY¬O¸ò¾Ú  RowSource ©Ò¶Ç¦^¦ì¸mªº²Ä¤@¦Cªº¤W¤@¦C¬°ªíÀY
©Ò¥HSet mRng6a = .Range("p4").CurrentRegion ®ÉªíÀY¬Op3¦C §A·|»{¬°¬O¤U²¾¤@¦C
­×¥¿¬° ¦p¤U «K¥i
Set mRng6a = .Range("p4").CurrentRegion
Set mRng6a = mRng6a.Offset(1).Resize(mRng6a.Rows.Count - 1, mRng6a.Columns.Count)

TOP

ÁÂÁª©¥D¤j¤j¡C

³]©w list.ColumnHeads = True ®ÉªíÀY¬O
¸ò¾Ú  RowSource ©Ò¶Ç¦^¦ì¸mªº²Ä¤@¦Cªº¤W¤@¦C¬°ªíÀY

ÁÂÁª©¥D¤j¤j¦p¦¹²Ó¿°ªº»¡©ú¡C
¤p§Ì¤w§¹¥þ¤F¸Ñ¨ä¤¤ªº·N§t¡C

¦b¦¹¶é¦a¡A¯à¨ü¨ì¦U¦ìª©¥D¤j¤jªº¬Û§U¡A
¯u¬O·P¿E¸U¤À¡A¤]Åý¤p§Ì¦b»yªk¤W¯à
§ó¥[¯àÀ³¥Î¦Û¦p¡C

·P®¦¦U¦ì¤j¤j¡I

TOP

        ÀR«ä¦Û¦b : §g¤l¬°¥Ø¼Ð¡A¤p¤H¬°¥Øªº¡C
ªð¦^¦Cªí ¤W¤@¥DÃD