yen956

¸Õ¸Õ¬Ý:

1. '½Ð¶K¨ì "·JÁ`ªí"
   
2. Sub ·J¤JÁ`ªí()
   
3.     Dim sh1 As Worksheet, sh2 As Worksheet
   
4.     Dim Lst1 As Integer, Lst2 As Integer
   
5.     Dim I As Integer, J As Integer
   
6.     Set sh1 = Sheets("·JÁ`ªí")
   
7.     For J = 1 To Sheets.Count
   
8.         If Sheets(J).Name <> "·JÁ`ªí" Then
   
9.             Set sh2 = Sheets(J)
   
10.             Lst1 = sh1.[B65536].End(xlUp).Row
    
11.             Lst2 = sh2.[B65536].End(xlUp).Row
    
12.             For I = 5 To Lst2
    
13.                 sh2.Cells(I, 2).Resize(1, 4).Copy sh1.Cells(Lst1 + I - 4, 2)
    
14.             Next
    
15.         End If
    
16.     Next
    
17. End Sub

½Æ»s¥N½X

yen956

¦^´_ 3# ¾Ç¨ì¦Ñ¦º
¥H¤U¾Þ§@«Y¥H 2003¬°¨Ò               
§Aªºª©¥»½Ð¦Û¦æ°Ñ¦Ò¡G               
1. «ö Alt+F11       
2. Double Click sheet("·JÁ`ªí")       
3. ¶K¤W VBA Code       
4. ÂI¥¨¶° Sub()¡Kend       
5. «ö F5       

¤U¸ü (460.44 KB)

2016-2-19 17:37

yen956

¦^´_ 5# ¾Ç¨ì¦Ñ¦º
'·J¥X¨ì¤À­¶
'¥ý¨M±ø¥ó:"·JÁ`ªí"ÄæB¤¤ªºsheets¥²¶·¦s¦b
Sub ·J¥X¨ì¤À­¶()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim Lst1 As Integer, Lst2 As Integer
    Dim I As Integer, J As Integer, shName As String
    Set sh1 = Sheets("·JÁ`ªí")
    Lst1 = sh1.[B65536].End(xlUp).Row
    For I = 5 To Lst1
        shName = sh1.Cells(I, 2)
        For J = 1 To Sheets.Count
            If Sheets(J).Name = shName Then
                Lst2 = Sheets(J).[B65536].End(xlUp).Row + 1
                If Lst2 < 5 Then Lst2 = 5
                sh1.Cells(I, 2).Resize(1, 4).Copy Sheets(J).Cells(Lst2, 2)
                Exit For
            End If
        Next
    Next
End Sub

yen956

¦^´_ 7# c_c_lai
ÁÂÁÂc¤jªº«ü¾É!!
§ï¥Îc¤jªº UsedRange ¥i§å¦¸¶K¤W, ªGµM²±¶¦h¤F, ÁÂÁ«ü¥¿!!

yen956

'­Y¸ê®ÆÃe¤j, ·J¥X¸ê®Æ¨ì¤À­¶, ¥i§ï¥Î¥»VBA, ·|§Ö«Ü¦h
'¥ý¨M±ø¥ó:"·JÁ`ªí"ÄæB¤¤ªº¤u§@ªí¦WºÙªºsheets¥²¶·¦s¦b
'¥B¤w«ö¤u§@ªí¦WºÙ±Æ§Ç
Sub ·J¥X¨ì¤À­¶2()
    Dim sh1 As Worksheet
    Dim Lst1 As Integer, shNameCnt As Integer
    Dim I As Integer
    Set sh1 = Sheets("·JÁ`ªí")
    Lst1 = sh1.[B65536].End(xlUp).Row
    I = 5
    Do
        shName = sh1.Cells(I, 2)
        sh1.[C3].FormulaR1C1 = "=COUNTIF(C[-1],""=""&R" & I & "C[-1])"   '­pºâ¦P¦Wªº¤u§@ªí¦³´X­Ó
        sh1.Cells(I, 2).Resize(sh1.[C3], 4).Copy Sheets(shName).[B5]     '§å¦¸½Æ»s
        I = I + sh1.[C3]
    Loop Until I > Lst1
End Sub

yen956

'­É¥Î 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

yen956

¦^´_ 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¤°»ò?ÁÂÁÂ!!

yen956

¦^´_ 16# ­ã´£³¡ªL
¦^´_ lpk187:
¦^´_ ­ã¤j:
ÁÂÁ¨â¦ì¸Ô²Óªº»¡©ú, ÁÂÁÂ!!

yen956

'·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