- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 107
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-5-9
|
¦^´_ 4# rouber590324
¸Õ¸Õ¬Ý- Sub ex()
- Dim A As Range
- Set d = CreateObject("Scripting.Dictionary")
- With Sheets(1)
- For Each A In .Range(.[A1], .[A1].End(xlDown))
- If d(Left(A, 7)) = "" Then
- d(Left(A, 7)) = Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
- Else
- d(Left(A, 7)) = d(Left(A, 7)) & Chr(10) & Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
- End If
- Next
- For Each ky In d.keys
- ar = Split(d(ky), Chr(10))
- For Each c In ar
- If Split(c, ";")(4) = "" Then d.Remove ky
- Next
- Next
- On Error Resume Next
- For Each ky In d.keys
- ar = Split(d(ky), Chr(10))
- For Each c In ar
- ay = Split(c, ";")
- ay(3) = CDate(ay(3))
- ay(4) = CDate(ay(4))
- Sheets(2).Cells(r + 1, 1).Resize(, 5) = ay
- r = r + 1
- Next
- Next
- End With
- End Sub
½Æ»s¥N½X |
|