- ©«¤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# tony0318
¯Â°Ñ¦Ò ¥t¤@ºØ¤è¦¡ ¨Ï¥Î °}¦C
Sub Ex()
Dim Ar(), M$, A As Range, i%
ReDim Ar(0)
With Sheet1
Set Ar(0) = .Range("A1").Resize(1, 12)
M = .Range("C1")
For Each A In .Range(.[A2], .[A65536].End(xlUp))
If UBound(Filter(Split(M, ","), A(1, 3), True)) > -1 Then
i = Application.Match(A(1, 3), Split(M, ","), 0)
Set Ar(i - 1) = Union(Ar(i - 1), A.Resize(1, 12))
Else
M = M & "," & A(1, 3)
ReDim Preserve Ar(UBound(Ar) + 1)
Set Ar(UBound(Ar)) = Union(Ar(0), A.Resize(1, 12))
End If
Next
End With
On Error GoTo NewSheet
For i = 1 To UBound(Split(M, ","))
With Sheets(Split(M, ",")(i))
.Cells.Clear
Ar(i).Copy .Range("A1")
End With
Next
Sheet1.Activate
Exit Sub
NewSheet:
With Sheets.Add(after:=Sheets(Sheets.Count))
.Name = Split(M, ",")(i)
End With
Resume
End Sub |
|