kai6929

·PÁ¤j®v±zªº¦^ÂÐ,³o¥¿¬O§Ú­nªº

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

kai6929

½Ð±Ð¦U¦ì¤j®v­Ì,¤È¦w

¯à§_¥H¥¨¶°ªº¥\¯à¹F¨ì¦¹®ÄªG,   
1.­º¥ý¦bSheet1 ©³¤U¿é¤J¸ê®Æ«á«ö¤U¡½¥[¤u¤@ B3:TRUE ¡B¡½¥[¤u¤@ B5:TRUE
2.SHEET2 §e²{µ²ªG¦p¤U

kai~19.rar (100.73 KB)

¤U¸ü¦¸¼Æ: 7

2012-11-2 11:34

¤U¸ü (170.67 KB)

2012-11-2 11:34