Ãö©ó¼g¥¨¶°µ{¦¡¦Û°Ê¿z¿ï§PÂ_°Ïªº¥N½X½Æ»s¦¨¸Ó¥N½X³æ¿W¬¡¶Ã¯
- ©«¤l
- 2035
- ¥DÃD
- 24
- ºëµØ
- 0
- ¿n¤À
- 2031
- ÂI¦W
- 0
- §@·~¨t²Î
- Win7
- ³nÅ骩¥»
- Office2010
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-3-22
- ³Ì«áµn¿ý
- 2024-2-1
|
¦^´_ 10# ¾Ç¨ì¦Ñ¦º
¦^´_ 9# yen956
¬°°t¦X¹ê°È¤Wªº¹ê»ÚÀ³¥Î¡A±N¥¦¾ã²z¤F¤@¤U¡A
¨Ã¤Þ¥Î¤@¨Ç¥i¯à¦]¯À¡A¥H¤Î¨B§½¦Ò¶q¡B¦Ó°µ
¥Xªº½d¨Ò¡A´£¨Ñ°Ñ¦Ò¬Ý¬Ý¡I- ' ½Ð¶K¨ì "·JÁ`ªí"
- Sub ·J¤JÁ`ªí()
- Dim sh1 As Worksheet, sh2 As Worksheet
- Dim Lst1 As Integer
- Dim J As Integer
- Dim msg As Boolean
-
- Set sh1 = Sheets("·JÁ`ªí")
- sh1.Cells.Clear
- msg = False
-
- For J = 1 To Sheets.Count
- If Sheets(J).Name <> "·JÁ`ªí" Then
- Set sh2 = Sheets(J)
- Lst1 = IIf(sh1.[B65536].End(xlUp).Row = 1, 1, sh1.[B65536].End(xlUp).Row + 1)
- ' sh2.UsedRange.Address = "$B$4:$E$7" : String
- ' sh2.UsedRange.Offset(1, 0).Address = "$B$5:$E$8" : String
- ' ²Ä¤@¦¸»Ý¥ý³s¦P¼ÐÃD¤Î¨ä¤º®e¤@¨Ö·J¤J¨ìÁ`ªí¤º¡A¤§«á¶È½Æ»s¨C¤@¤u§@ªí³æ¤§¤º®e (¤£§t¼ÐÃD¦b¤º)¡C
- sh2.UsedRange.Offset(IIf(msg, 1, 0), 0).Copy sh1.Cells(Lst1, 2)
- msg = True
- End If
- Next
- End Sub
- ' ·J¥X¨ì¤À¶
- ' À³¥Î½d³ò¡G «Ø¥ß¦r¨å¡B¤j¤p±Æ§Ç¡B¶K»s½Æ»s¤º®e¡B¦p¦óÀˬd¤u§@ªí³æ¤w§_¦s¦b¡B°ÊºA²£¥Í¤u§@ªí³æ¡B
- ' ²M°£¼È¦s¤u§@°Ï¶ô¡B¥H¤Î¦r¨åªº¹ê°ÈÀ³¥Î»P§Þ¥©¡C
- Sub ·J¥X¨ì¤À¶()
- Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, dic As Object
- Dim Lst1 As Integer, v As Variant
- Dim J As Integer, I As Integer
-
- Set dic = CreateObject("scripting.dictionary")
- Set sh1 = Sheets("·JÁ`ªí")
- Lst1 = sh1.[B65536].End(xlUp).Row
-
- sh1.Range("B1:E" & Lst1).Copy sh1.[W1] ' ¥tÅP¾Ô³õ (B Äæ¥ý«ö·Ó¦r¥À¤j¤p±Æ§Ç«á¦A¦æ·J¥X¨ì¦U¬ÛÃö¤u§@ªí³æ)
- With [W2].Resize(Lst1 - 1, 4)
- .Cells.Sort Key1:=.Cells(1), Key2:=.Cells(3), Order1:=xlAscending, Header:=xlNo ' xlDescending
- End With
-
- For J = 2 To Lst1
- dic(sh1.Range("W" & J).Text) = dic(sh1.Range("W" & J).Text) + 1
- Next J
-
- Set rng = Sheets("·JÁ`ªí").[W2]
- For Each v In dic.KEYS ' v = "A" : Variant/String
- I = dic.Item(v) ' I = 3 : Integer
- J = checkShts(CStr(v))
-
- If J > 0 Then
- Set sh2 = Sheets(J)
- Else
- Set sh2 = Sheets.Add(After:=Sheets(Sheets.Count))
- sh2.Name = v
- End If
-
- With sh2
- .Cells.Clear
- sh1.[W1:Z1].Copy .[B1]
- rng.Resize(I, 4).Copy .[B2]
- Set rng = rng.Offset(I) ' Rng.Address = "$B$5" : Rng.Address = "$B$7" : String
- End With ' Rng.Address = "$B$8" : String
- Next
- sh1.[W:Z].Clear ' ²M°£¥tÅP¤§¾Ô³õ (W ¦Ü Z Ä涡¤º®e)
- End Sub
- Function checkShts(vSht As String) As Integer
- Dim flg As Integer
-
- For flg = 1 To Sheets.Count
- If Sheets(flg).Name = vSht Then checkShts = flg: Exit Function
- Next flg
- checkShts = 0
- End Function
½Æ»s¥N½X |
|
|
|
|
|
|
- ©«¤l
- 522
- ¥DÃD
- 36
- ºëµØ
- 1
- ¿n¤À
- 603
- ÂI¦W
- 0
- §@·~¨t²Î
- win xp sp3
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-12-13
- ³Ì«áµn¿ý
- 2021-7-11
|
'ɥΠc¤j ªº·§©À, ·s¼W¤À¶, ³o¼Ë¸û¦³¼u©Ê
'½Ð¶K¨ì "·JÁ`ªí"
'·J¥X¨ì¤À¶3
'§P§P¤À¶¬O§_¦s¦b
Function shExist(ByVal shName As String) As Boolean
Dim I As Integer
shExist = False
For I = 1 To Sheets.Count
If Sheets(I).Name = shName Then
shExist = True
Exit Function
End If
Next
End Function
Sub ·J¥X¨ì¤À¶3()
Dim sh1 As Worksheet
Dim Lst1 As Integer, shNameCnt As Integer
Dim I As Integer, J As Integer
'********************
'²M°£¤À¶¤º®e, ¦p¦³¨ä¥L«n¤À¶, ¦p"²Îp"µ¥, ¨â¦C*****¶¡, ½Ðµù¸Ñ±¼©Î§R±¼
For J = 1 To Sheets.Count
If Sheets(J).Name <> "·JÁ`ªí" Then Sheets(J).Cells.Clear
Next
'**************
'¥[¤Jì§Ç¸¹, ¤è«K«ì´_쪬(¼È©ñÄæA,¥i§ï©ñ§OÄæ)
Lst1 = [B65536].End(xlUp).Row
[A5] = 1: Range("A5:A" & Lst1).DataSeries
'«ö¤u§@ªí¦WºÙ±Æ§Ç
[A5].Resize(Lst1 - 5, 5).Sort Key1:=[B5], Order1:=xlAscending, Header:=xlNo
For I = 5 To Lst1
shName = Cells(I, 2)
'§P§P¤À¶¬O§_¦s¦b, ¦p¤£¦s¦b«h·s¼W¤@¶
If Not shExist(shName) Then
Set sh1 = Sheets.Add(After:=Sheets(Sheets.Count))
sh1.Name = shName
End If
[C4:E4].Copy Sheets(shName).[C4] '½Æ»s¼ÐÃD
[C3].FormulaR1C1 = "=COUNTIF(C[-1],""=""&R" & I & "C[-1])" 'pºâ¦P¦Wªº¤u§@ªí¦³´XÓ
Cells(I, 2).Resize([C3], 4).Copy Sheets(shName).[B5] '§å¦¸½Æ»s
I = I + [C3] - 1
Next
'«ì´_쪬, «öì§Ç¸¹±Æ§Ç, ¨Ã²M°£¼È¦s°Ï
[A5].Resize(Lst1 - 5, 5).Sort Key1:=[A5], Order1:=xlAscending, Header:=xlNo
[A:A].Clear: [C3].Clear 'ÄæA ¤Î [C3] §¡¬°¼È¦s°Ï
End Sub |
|
|
|
|
|
|
- ©«¤l
- 2834
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2890
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-11-25
|
¿z¿ïªk¡I¡I¡I
Sub Macro1()
Dim xArea As Range, i&, T$, TT$, Sht As Worksheet
Set xArea = Range([B4], Cells(Rows.Count, "B").End(xlUp)(1, 4))
For i = 2 To xArea.Rows.Count
¡@¡@T = xArea(i, 1): Set Sht = Nothing
¡@¡@If T = "" Or InStr(TT & "/", "/" & T & "/") Then GoTo 101
¡@¡@On Error Resume Next: Set Sht = Sheets(T): On Error GoTo 0
¡@¡@If Sht Is Nothing Then Set Sht = Sheets.Add(After:=Sheets(Sheets.Count))
¡@¡@Sht.Name = T: Sht.UsedRange.Clear
¡@¡@With xArea
¡@¡@¡@¡@.Parent.Select
¡@¡@¡@¡@.AutoFilter Field:=1, Criteria1:=T
¡@¡@¡@¡@.Copy Sht.[B4]
¡@¡@End With
¡@¡@TT = TT & "/" & T
101: Next i
ActiveSheet.AutoFilterMode = False
End Sub |
|
|
|
|
|
|
- ©«¤l
- 522
- ¥DÃD
- 36
- ºëµØ
- 1
- ¿n¤À
- 603
- ÂI¦W
- 0
- §@·~¨t²Î
- win xp sp3
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-12-13
- ³Ì«áµn¿ý
- 2021-7-11
|
¦^´_ 13# ã´£³¡ªL
ã¤j§A¦n!!
¤S¾Ç¨ì¤@©Û, ª½±µ
Set Sht = Nothing
If T = "" Or InStr(TT & "/", "/" & T & "/") Then GoTo 101
On Error Resume Next
Set Sht = Sheets(T)
On Error GoTo 0
If Sht Is Nothing Then
Set Sht = Sheets.Add(After:=Sheets(Sheets.Count))
End If
´N¥i¥H¤£¥²¥ý§PÂ_sht¬O§_¦s¦b,¯u°ª, ¦¬¤U, ÁÂÁÂ!!
¦ý½Ð°Ý InStr(TT & "/", "/" & T & "/") ªº§@¥Î¬O¤°»ò?ÁÂÁÂ!! |
|
|
|
|
|
|
- ©«¤l
- 552
- ¥DÃD
- 3
- ºëµØ
- 0
- ¿n¤À
- 578
- ÂI¦W
- 0
- §@·~¨t²Î
- win7
- ³nÅ骩¥»
- office 2010
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2015-2-8
- ³Ì«áµn¿ý
- 2024-7-9
|
¦^´_ 14# yen956
§Ú·QInStr(TT & "/", "/" & T & "/")ªº·N«ä¬°
·í²Ä¤@¦¸Åª¨ú¹Lªº¤u§@ªí¦WºÙ·|¼g¤J¨ìÅܼÆTTªº¦r¦ê¤¤¡A¦]¬°¤w¸g°µ¹L¿z¿ï¤F¡A©Ò¥H·í¦A¦¸Åª¨ú¨ì´¿°O¿ý¹Lªº¦WºÙ®É¸õ¹L
¦Ó"/"«h¬On°Ï¤À¦U¤u§@ªí¦Wªº°Ï¹j¡A¤£·|«ÂСAÅýInStr®e©ö§PÂ_¡A¦Ó¤£·|²£¥Í¿ù»~ªº§PÂ_ |
|
|
|
|
|
|
- ©«¤l
- 2834
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2890
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-11-25
|
¥»©«³Ì«á¥Ñ ã´£³¡ªL ©ó 2016-2-22 12:06 ½s¿è
¦^´_ 15# lpk187
§¹¥þ¥¿½T, ÁÂÁ¤j¥X¤O¸ÑÄÀ!
InStr(TT & "/", "/" & T & "/")¡@¥Î"/'¤À¹j¡A¥i¥H²M·¡¤À§O A AA AAA ©Î¡@A1 A11 A111¡A¦Ó¤£·|»~§P¡I¡I
¦Ó¥B²z½×¤W¡A¤u§@ªí¦WºÙ¤£·|¦³"/"¦r¤¸¡AY¥Î¨ä¥¦²Å¸¹¡A´Nn¦Ò¼{¤u§@ªíªí¦WºÙ¬O§_§t¦³³oӲŸ¹¡A
¨Ò¦p¡G¥Î"-"¤À¹j¡A´N¥i¯à¹ï 1-1 1-11 1-111 ¬Û¦ü¤u§@ªí»~§P¡I¡I |
|
|
|
|
|
|
- ©«¤l
- 522
- ¥DÃD
- 36
- ºëµØ
- 1
- ¿n¤À
- 603
- ÂI¦W
- 0
- §@·~¨t²Î
- win xp sp3
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-12-13
- ³Ì«áµn¿ý
- 2021-7-11
|
¦^´_ 16# ã´£³¡ªL
¦^´_ lpk187:
¦^´_ ã¤j:
ÁÂÁ¨â¦ì¸Ô²Óªº»¡©ú, ÁÂÁÂ!! |
|
|
|
|
|
|
- ©«¤l
- 522
- ¥DÃD
- 36
- ºëµØ
- 1
- ¿n¤À
- 603
- ÂI¦W
- 0
- §@·~¨t²Î
- win xp sp3
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-12-13
- ³Ì«áµn¿ý
- 2021-7-11
|
'·J¥X¨ì¤À¶4(¯Â¦Û§Ú¾Ç²ß VBA ¥Î, §OµL¥¦·N):
'§ó·sª©, §ó·s«ÂI¦p¤U:
'1. ¬JµM ÄæA¤Î[C3] §¡¬°¼È¦s°Ï, «hÀ³¾ã¦X¨ì¦P¤@Ä椤, ¬G[C3]À³§ï¨ì[A3]
'2. ¨â¦C*****¶¡ªº ²M°£¤À¶ À³²¾ "¥Dµ{¦¡" ¦¡¤º, ¥iÁקK»~§R«n¸ê®Æ
'3. §ï¥Îã¤jªº·§©À, ¤£¥t§P§O¤À¶¬O§_¦s¦b, §Y§R°£ Function shExist, ¥i¬Ù±¼¤£¤Ö°j°é
'
'§ó¥¿µ²ªG¦p¤U:
'½Ð¶K¨ì "·JÁ`ªí"
Sub ·J¥X¨ì¤À¶4()
Dim sh1 As Worksheet
Dim Lst1 As Integer, shName As String
Dim i As Integer, J As Integer
Lst1 = [B65536].End(xlUp).Row
'¥[¤Jì§Ç¸¹, ¤è«K«ì´_쪬(¼È©ñÄæA,¥i§ï©ñ§OÄæ)
[A5] = 1: Range("A5:A" & Lst1).DataSeries
'«ö¤u§@ªí¦WºÙ±Æ§Ç
[A5].Resize(Lst1 - 5, 5).Sort Key1:=[B5], Order1:=xlAscending, Header:=xlNo
'¥Dµ{¦¡
For i = 5 To Lst1
shName = Cells(i, 2)
Set sh1 = Nothing
On Error Resume Next
Set sh1 = Sheets(shName)
On Error GoTo 0
'Y sh1 ¤´¬° Nothing ¡÷ ¦W¬° shName ªº¤u§@ªí¨Ã¤£¦s¦b ¡÷ ¼W¥[·s¤u§@ªí
If sh1 Is Nothing Then
Set sh1 = Sheets.Add(After:=Sheets(Sheets.Count))
sh1.Name = shName
End If
sh1.Cells.Clear '²M°£¤À¶
[B4:E4].Copy sh1.[B4] '½Æ»s¼ÐÃD
[A3].FormulaR1C1 = "=COUNTIF(C[1],""=""&R" & i & "C[1])" 'pºâ¦P¦Wªº¤u§@ªí¦³´XÓ
Cells(i, 2).Resize([A3], 4).Copy sh1.[B5] '§å¦¸½Æ»s¦P¦Wªº¤u§@ªí
i = i + [A3] - 1 '¸õ¨ì¤UÓ¤£¦P¦W¤u§@ªí, ¬G¤£¥Î¿z¿ï
Next
'«ì´_쪬 ¡÷ «öì§Ç¸¹±Æ, ¨Ã²M°£¼È¦s°Ï
[A5].Resize(Lst1 - 5, 5).Sort Key1:=[A5], Order1:=xlAscending, Header:=xlNo
[A:A].Clear '²M°£¼È¦s°Ï ÄæA
End Sub |
|
|
|
|
|
|
- ©«¤l
- 2035
- ¥DÃD
- 24
- ºëµØ
- 0
- ¿n¤À
- 2031
- ÂI¦W
- 0
- §@·~¨t²Î
- Win7
- ³nÅ骩¥»
- Office2010
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-3-22
- ³Ì«áµn¿ý
- 2024-2-1
|
¥»©«³Ì«á¥Ñ c_c_lai ©ó 2016-2-23 09:22 ½s¿è
¦^´_ 19# Hsieh - sh.[B4].Resize(UBound(ay) + 1, 4) = Application.Transpose(Application.Transpose(ay))
½Æ»s¥N½X °õ¦æ¨ì¦¹¦æ¡A§Y²£¥Í "«¬ºA¤£²Å (#13)" |
|
|
|
|
|
|