- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 1# asus103 - Option Explicit
- Sub Ex()
- Dim D(1) As Object, F As Range, MyClass$, F_Address$, Rng As Range, C, R, D_Key$, ARng As Range
- Set D(0) = CreateObject("SCRIPTING.DICTIONARY")
- Set D(1) = CreateObject("SCRIPTING.DICTIONARY")
- With Sheets("Sheet1")
- Set F = .Range("B:B").Find(what:="¾Ç¡@¸¹", After:=.[b1], Lookat:=xlWhole)
- If Not F Is Nothing Then
- F_Address = F.Address
- Do
- Set Rng = .Range(F, F.End(xlToRight).End(xlDown))
- MyClass = F.Offset(-2)
- For Each C In Rng.Columns(1).Cells
- If IsNumeric(C) Then
- D_Key = C & "," & C(1, 2) & "," & MyClass & "," & C(1, 3)
- D(0)(D_Key) = ""
- For R = 4 To Rng.Columns.Count
- If Rng(1, R) <> "" Then D(1)(D_Key & Rng(1, R)) = .Cells(C.Row, Rng(1, R).Column)
- Next
- End If
- Next
- Set F = .Range("B:B").FindNext(F)
- Loop While F_Address <> F.Address
- With Sheets("Sheet4")
- .UsedRange.Offset(1).Clear
- For Each R In D(0).KEYS
- Set ARng = .Range("A" & Rows.Count).End(xlUp).Offset(1)
- ARng.Resize(, 4) = Split(R, ",")
- For C = 5 To .[A1].End(xlToRight).Column
- If .Cells(1, C) <> "" Then ARng(1, C) = D(1)(R & .Cells(1, C))
- Next
- Next
- End With
- End If
- End With
- End Sub
½Æ»s¥N½X |
|