GBKEE

¦^´_ 1# kai6929
ªþÀɦ³¤T­Ó ¤@¯ë¼Ò²Õ³£¦³ check() ³oµ{¦¡·|·d½k¶îªº

1. Option Explicit
   
2. Sub check()
   
3.     Dim K As String, M As Boolean, xRow As Integer, xi As Integer
   
4.     With ActiveSheet.Shapes(Application.Caller)
   
5.         With .TextFrame
   
6.             K = .Characters.Text
   
7.             If Left(K, 1) = "¡½" Then
   
8.                 .Characters.Text = "¡¼¥[¤u¤@"
   
9.                 M = False
   
10.             Else
    
11.                 .Characters.Text = "¡½¥[¤u¤@"
    
12.                 M = True
    
13.             End If
    
14.             .Characters(1, Len(K) + 1).Font.Size = 10
    
15.             .Characters(1, 1).Font.Size = 10
    
16.         End With
    
17.         .TopLeftCell.Offset(, 1) = M
    
18.         .TopLeftCell.Offset(, 2) = IIf(CSng(M) = 0, 0, 1)
    
19.     End With
    
20.     Sheet2.UsedRange.Offset(1).Clear
    
21.     xRow = 3
    
22.     With ActiveSheet
    
23.     Do While .Cells(xRow, "C") <> ""
    
24.         If .Cells(xRow, "C") = 1 Then
    
25.             xi = xi + 1
    
26.             Sheet2.Rows(1).Copy Sheet2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    
27.            With Sheet2.Cells(Rows.Count, "A").End(xlUp)
    
28.            .Cells(1) = xi
    
29.            .Cells(1, 3) = ActiveSheet.Cells(xRow, "D")
    
30.            .Cells(1, 6) = ActiveSheet.Cells(xRow, "H")
    
31.            .Cells(1, 7) = ActiveSheet.Cells(xRow, "I")
    
32.            .Cells(1, 9) = ActiveSheet.Cells(xRow, "K")
    
33.            End With
    
34.         End If
    
35.         xRow = xRow + 1
    
36.     Loop
    
37.     End With
    
38. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# mark15jill
½T¹ê¬O¶·¦p¦¹ªº,¤@¨Ó¥iª¾°ÝÃDªº·½¬G ,¤G¬O¥i¸`¬Ù½×¾Â¸ê·½.

¦^´_ 4# kai6929
³o¥u¬O±N¥Ø­ì¥». 1#µo°Ý­n½Æ»s¦bSheet2.A2ªº¸ê®Æ,²¾°Ê¨ìSheet2.L13
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub check()
   
3.     Dim K As String, M As Boolean, xRow As Integer, xi As Integer
   
4.     Dim Rng As Range
   
5.     With ActiveSheet.Shapes(Application.Caller)
   
6.         With .TextFrame
   
7.             K = .Characters.Text
   
8.             If Left(K, 1) = "¡½" Then
   
9.                 .Characters.Text = "¡¼¥[¤u¤@"
   
10.                 M = False
    
11.             Else
    
12.                 .Characters.Text = "¡½¥[¤u¤@"
    
13.                 M = True
    
14.             End If
    
15.             .Characters(1, Len(K) + 1).Font.Size = 10
    
16.             .Characters(1, 1).Font.Size = 10
    
17.         End With
    
18.         .TopLeftCell.Offset(, 1) = M
    
19.         .TopLeftCell.Offset(, 2) = IIf(CSng(M) = 0, 0, 1)
    
20.     End With
    
21.     Sheet2.Range("L13").CurrentRegion.Offset(1).Clear
    
22.     Set Rng = Sheet2.Range("L13").CurrentRegion.Rows(1)
    
23.     With ActiveSheet
    
24.         xRow = 25
    
25.         Do While .Cells(xRow, "C") <> ""
    
26.             If .Cells(xRow, "C") = 1 Then
    
27.                 xi = xi + 1
    
28.                 Rng.Copy
    
29.                 With Sheet2.Cells(Rows.Count, "L").End(xlUp).Offset(1)
    
30.                     .PasteSpecial
    
31.                     .Cells(1) = xi                               '¶µ¦¸
    
32.                     '¸ê®Æ¦s©ñ¦b¦X¨ÖÀx¦s­Óªº²Ä1­ÓCells
    
33.                     .Cells(1, 2) = ActiveSheet.Cells(xRow, "A")  '¥[¤u¶µ¥Ø
    
34.                     .Cells(1, 3) = ActiveSheet.Cells(xRow, "F")  '¥[¤u³W®æ
    
35.                     .Cells(1, 6) = ActiveSheet.Cells(xRow, "H")  '(³æ»ù)
    
36.                     .Cells(1, 7) = ActiveSheet.Cells(xRow, "I")  '¦¸¼Æ
    
37.                     .Cells(1, 8) = ActiveSheet.Cells(xRow, "K")  '¥[¤u¶O¥Î
    
38.                 End With
    
39.             End If
    
40.             xRow = xRow + 1
    
41.         Loop
    
42.     End With
    
43.     Application.CutCopyMode = False
    
44. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 8# kai6929
¨ºµ{¦¡½X¬Oµ¹Sheet2¥Îªº,¸ê®Æ¤S­n§ï©ñSheet1,¦³ÃöSheet2ªºµ{¦¡½X,¨º§A­n§ï¤@¤U

GBKEE

¦^´_ 11# kai6929
¤W¶Ç­×§ïªºÀÉ®× ¬Ý¬Ý