- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 277
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-12-23
|
¦^´_ 15# wsx24680 - Private Sub CommandButton1_Click()
- Dim A As Range, Rng As Range, B As Range
- Set dc = CreateObject("Scripting.Dictionary")
- Set ds = CreateObject("Scripting.Dictionary")
- With Sheet222
- For Each A In .Range(.[C7], .[C65536].End(xlUp))
- mystr = Mid(A, 5, 3)
- If IsError(Application.Match(mystr, Sheet201.[E10:K10], 0)) Then mystr = "Other"
- Set Rng = .Cells(A.Row, "AM").Resize(, 7)
- If Application.CountA(Rng) > 0 Then Set Rng = Rng.SpecialCells(xlCellTypeConstants) Else GoTo 10
- For Each B In Rng
- m1 = mystr & A.Offset(, 8) & B
- m2 = mystr & B & B.Offset(, 7)
- m3 = mystr & A.Offset(, 8) & .Cells(5, B.Column) & B
- dc(m1) = dc(m1) + 1
- dc(m2) = dc(m2) + 1
- ds(m1) = ds(m1) + B.Offset(, 14)
- ds(m3) = ds(m3) + B.Offset(, 14)
- Next
- 10
- Next
- End With
- With Sheet201
- Set Rng = .Columns("C").SpecialCells(xlCellTypeConstants)
- For Each A In Rng
- If A = "¾P°â¥[Á`¼Æ¶q" Then yn = True
- If InStr(A, "¨C¤é¾P°â¼Æ¶q") > 0 Then mystr1 = Mid(A, 1, 3)
- If A.MergeCells = False Then
- If A.Row < 47 Then
- For Each B In .[E10:K10]
- mystr = B & A & A.Offset(, 1)
- If yn = True Then .Cells(A.Row, B.Column) = ds(mystr) Else .Cells(A.Row, B.Column) = dc(mystr)
- Next
- Else
- For Each B In .[E48:K48]
- mystr = mystr1 & A & B & A.Offset(, 1)
- .Cells(A.Row, B.Column) = ds(mystr)
- Next
- End If
- End If
- Next
- End With
- Set dc = Nothing
- Set ds = Nothing
- MsgBox ("®¥³ß±z~²Îp§¹¦¨!!") 'µ²§ôµøµ¡´£¥Ü
- End Sub
½Æ»s¥N½X |
|