samwang

¦^´_ 1# q1a2z5

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C

Sub tt()
Dim Arr, Brr(1 To 13, 1 To 1), T, T2, i%, j%, Y%, N%, N1%
Y = 3
For sh = 2 To Sheets.Count
    With Sheets(sh).Range("A4:G12")
        Arr = .Value
        For i = 1 To 4
            For j = 2 To UBound(Arr, 2)
                If InStr(Arr(i, j), "¤ë") = False Then GoTo 98
                T = Mid(Arr(i, j), 1, Len(Arr(i, j)) - 1): T2 = Arr(i + 1, j)
                If T2 <> "" Then N = N + 1: Brr(T + 1, 1) = T2
98:         Next j
        Next i
        If N > 0 Then
            Brr(1, 1) = Sheets(sh).Name
            Sheets("¿é¤Jªí").Cells(2, Y).Resize(13, 1) = Brr
            Erase Brr
        End If      
        For i = 5 To 8
            For j = 2 To UBound(Arr, 2)
                If InStr(Arr(i, j), "¤ë") = False Then GoTo 99
                T = Mid(Arr(i, j), 1, Len(Arr(i, j)) - 1): T2 = Arr(i + 1, j)
                If T2 <> "" Then N1 = N1 + 1: Brr(T + 1, 1) = T2
99:         Next j
        Next i
        If N1 > 0 Then
            Brr(1, 1) = Sheets(sh).Name
            Sheets("¿é¤Jªí").Cells(16, Y).Resize(13, 1) = Brr
            Erase Brr
        End If
        If N > 0 Or N1 > 0 Then N = 0: N1 = 0: Y = Y + 1
    End With
Next
End Sub

samwang

¦^´_ 3# q1a2z5

¤W¶ÇÀɮסA½Ð°õ¦æ¬Ý¬Ý¡AÁÂÁ¡C

samwang

¦^´_ 5# q1a2z5

¤£¦n·N«ä¡A¦Û¤v²Ê¤ß¤j·N¡A¨S¬Ý²M±zªº»Ý¨D¡A§Ú¦A¨Ó·Q¬Ý¬Ý¡AÁÂÁ¡C

samwang

¦^´_ 6# q1a2z5


¦pªþ¥ó½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

samwang

¦^´_ 9# q1a2z5

¤£¦n·N«ä¡A¯uªº¤£ª¾¹D±zªº»Ý¨D¡A©ÎªÌ±z¤è«K¤W¶ÇÀɮסA§Ú¦A¨Ó¬ã¨s¤@¤U¡AÁÂÁÂ

samwang

¦^´_ 9# q1a2z5

§Ú¤w¥[¤Wµù¸Ñ¡A©Î³\±z¥i¥H±q¸Ì­±¾Ç¨ì¤@¨Ç¦Û¤v·Q­nªº¡AµM«á¦Û¤v­×§ï½m²ßÀ³¥Î¡A
§Ú¤]¦b¾Ç²ß¤¤¡A½×¾Â¦³«Ü¦h¼F®`«e½ú¡A¥i¥H¦h¬Ý¬ÝÆ[¼¯¥L­Ìªº¼gªk©M«ä¦ÒÅÞ¿è¡A
¦Û¤v¦h¦h½m²ß´N·|¦³©Ò¦¨ªø¡A¤¬¬Û«jÀy¤§¡A·PÁ¡C

Sub tt()
Dim Arr, Ar(1 To 1, 1 To 6), Ar2(1 To 1, 1 To 6), Ar3(1 To 1, 1 To 6)
Dim Ar4(1 To 1, 1 To 6), T$, j&, i&, N%
Application.ScreenUpdating = False
Tm = Timer
Arr = Sheets("¿é¤Jªí").Range("a1:bb" & [¿é¤Jªí!B65536].End(3).Row) '¸ê®Æ¸Ë¤J¼Æ²Õ
For j = 3 To UBound(Arr, 2) '±q²Ä3Äæ¶}©l¨ì³Ì«á
    T = Arr(2, j) '¦~«×
    If T = "" Then GoTo 99 '¦pªG¦~«×ªÅ¥Õ´N´«¤U­Ó
    For i = 3 To 8: N = N + 1: Ar(1, N) = Arr(i, j): Next: N = 0     '109¦~1-6¤ë¸ê®Æ¸Ë¤JAr¼Æ²Õ
    For i = 9 To 14: N = N + 1: Ar2(1, N) = Arr(i, j): Next: N = 0   '109¦~7-12¤ë¸ê®Æ¸Ë¤JAr2¼Æ²Õ
    For i = 17 To 22: N = N + 1: Ar3(1, N) = Arr(i, j): Next: N = 0  '110¦~1-6¤ë¸ê®Æ¸Ë¤JAr3¼Æ²Õ
    For i = 23 To 28: N = N + 1: Ar4(1, N) = Arr(i, j): Next: N = 0  '110¦~7-12¤ë¸ê®Æ¸Ë¤JAr4¼Æ²Õ
    With Sheets(T)  '¨C­Ó¦~«×sheet
        .Range("B5").Resize(1, 6) = Ar      'Ar¸ê®Æ¶K¦ÜB5
        .Range("B7").Resize(1, 6) = Ar2     'Ar2¸ê®Æ¶K¦ÜB7
        .Range("B9").Resize(1, 6) = Ar3     'Ar3¸ê®Æ¶K¦ÜB9
        .Range("B11").Resize(1, 6) = Ar4    'Ar4¸ê®Æ¶K¦ÜB11
    End With
99: Next
Application.ScreenUpdating = True
MsgBox "°õ¦æ§¹¦¨" & Timer - Tm & " ¬í"
End Sub