GBKEE

¦^´_ 1# luke

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim R As Range, W As String, Rng As Range
   
4.     With ActiveSheet
   
5.         W = Application.Phonetic(.[D3:E3])       'µ²¦X¨â¦r¦ê
   
6.         For Each R In .Range("A:B").SpecialCells(xlCellTypeConstants).Rows '¦³¸ê®ÆªºÀx¦s®æ
   
7.             If W = Application.Phonetic(R) Then
   
8.                 If Rng Is Nothing Then
   
9.                     Set Rng = R
   
10.                 Else
    
11.                     Set Rng = Union(Rng, R)
    
12.                 End If
    
13.             End If
    
14.         Next
    
15.         If Rng Is Nothing Then
    
16.             MsgBox "¬dµL " & .[D3] & .[E3] & "¸ê®Æ"
    
17.         Else
    
18.             Rng.Select
    
19.             MsgBox "¦@ " & Rng.Cells.Count / 2 & "µ§ ¸ê®Æ"
    
20.         End If
    
21.     End With
    
22. End SubEnd Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# luke

1. Private Sub Auto_open()   'Module1 ©óÀɮ׶}±Ò®É¦Û°Ê°õ¦æªºµ{¦¡,­n©w¸q:"END"°Ï¶ô¦ì¸m
   
2.     'Names.Add ¬¡­¶Ã¯¤¤©w¸q·s¦WºÙ
   
3.         With sheet1.Range("A:A")
   
4.         If Not .Find("END", lookat:=xlWhole) Is Nothing Then
   
5.             .Replace "END", "=EX", xlWhole
   
6.             '±N"END"´À¥N¬°¤½¦¡,¦]¬°µL®Äªº¤½¦¡,Àx¦s®æ¶Ç¦^¿ù»~­È
   
7.             With .SpecialCells(xlCellTypeFormulas, xlErrors)
   
8.                 Names.Add "¸ê®Æ°Ï", RefersTo:=.Parent.Range(.Address)
   
9.                 .Value = "END"    'Àx¦s®æ¶Ç¦^¿ù»~­È:¦^´_­ì¦r¦ê
   
10.             End With
    
11.             Names.Add "«ö¶s¦¸¼Æ", 1           '«ö¶s1 ²Ä¤@­Ó¸ê®Æ°Ï
    
12.         Else
    
13.             Names.Add "«ö¶s¦¸¼Æ", 0           '«ö¶s1
    
14.         End If
    
15.     End With
    
16. End Sub
    
17. Sub Ex()
    
18.     Dim i As Integer, W As String, Rng As Range
    
19.     If [«ö¶s¦¸¼Æ] = 0 Then
    
20.         MsgBox "¸ê®Æ°Ï ¨S¦³ END°Ï¶ô "
    
21.         Exit Sub
    
22.     End If
    
23.     With ActiveSheet
    
24.         W = Application.Phonetic(.[D3:E3])       'µ²¦X¨â¦r¦ê
    
25.         'i = [¸ê®Æ°Ï].Areas([«ö¶s¦¸¼Æ]).Row       '²Ä i ­Ó"END"¸ê®Æ°Ïªº¦C¸¹
    
26.         For i = [¸ê®Æ°Ï].Areas([«ö¶s¦¸¼Æ]).Row To [¸ê®Æ°Ï].Areas([¸ê®Æ°Ï].Areas.Count).Row
    
27.             If W = Application.Phonetic(.Range("A:B").Rows(i)) Then
    
28.                 Names.Add "«ö¶s¦¸¼Æ", [«ö¶s¦¸¼Æ] + 1   '
    
29.                 Set Rng = .Range("A:B").Rows(i)
    
30.                 Exit For   '§ä¨ì²Ä¤@­Ó Â÷¶}°j°é
    
31.             End If
    
32.         Next
    
33.         If Rng Is Nothing Then
    
34.             MsgBox "¬dµL " & .[D3] & .[E3] & "¸ê®Æ"
    
35.         Else
    
36.             Rng.Select
    
37.             MsgBox "§ä¨ì " & Rng.Cells(1, 1).Address(0, 0)
    
38.         End If
    
39.     End With
    
40.      If [¸ê®Æ°Ï].Areas.Count = [«ö¶s¦¸¼Æ] Then Names.Add "«ö¶s¦¸¼Æ", 1     '[«ö¶s¦¸¼Æ] ¦^¨ì²Ä¤@¦¸
    
41. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 6# luke
ªG·Q¸õ¹L²Ä1­Ó¦³¡uEND¡v¸ê®Æ°Ï
¥u¦³1­Ó¡uEND¡v¸ê®Æ°Ï¶Ü??????
½Ð±N°ÝÃD§¹¾ãªº´£¥X¨Ó!!!

GBKEE

¦^´_ 8# luke
¤£¦n·N«ä,¬Ý¤F¨â¤Ñ,§A»¡ªº«Ü¸Ô²Ó¦ýÁÙ¬O¬Ý¤£À´
¥i¥Hªþ¤WÀɮתº4­Ó¤u§@ªí¤º®e¬O
1 [SHEET1 A]¤u§@ªí¬O  ¤å¦rÀÉA«¬
2 [SHEET1 B]¤u§@ªí¬O  ¤å¦rÀÉB«¬
3 [A WORK]¤u§@ªí¬O :  ¤å¦rÀÉA«¬ ¶K¤W[A WORK]¤u§@ªí «á °õ¦æ ½Æ»s ´¡¤J ªº½d¨Ò
4 [B WORK]¤u§@ªí¬O :   ¤å¦rÀÉB«¬ ¶K¤W[A WORK]¤u§@ªí «á °õ¦æ §R°£ ´¡¤J ªº½d¨Ò

GBKEE

¦^´_ 10# luke
°õ¦æ [¼g¤JWork]«e¶·¥ý°õ¦æ [Link] ½T©w¤u§@ªíªº¶W³sµ².

1. Sub Link()
   
2.     Dim D As Object, R As Integer, C As Range, A As Range, Ky As Variant
   
3.     Set D = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("sheet1")
   
5.         Set A = .[A:A].Find([J1], lookat:=xlWhole)
   
6.         If [J1] = "" Then Exit Sub
   
7.         For Each C In .Range(A, .[A65536].End(xlUp))
   
8.             If C & C.Offset(, 1) Like .[I3] & .[J3] Then
   
9.                 D(C.Value & D.Count) = C.Resize(, 2).Address(0, 0)
   
10.             End If
    
11.         Next
    
12.         [L:N].Clear
    
13.         If D.Count = 0 Then MsgBox "µL²Å¦X¸ê®Æ": Exit Sub
    
14.         For Each Ky In D.keys
    
15.             R = R + 1
    
16.             .Cells(R, "L") = .Range(D(Ky)).Cells(1, 1)
    
17.             .Cells(R, "M") = .Range(D(Ky)).Cells(1, 2)
    
18.             .Hyperlinks.Add Anchor:=.Cells(R, "N"), Address:="", SubAddress:=D(Ky)
    
19.         Next
    
20.     End With
    
21.     Range("J3").Select
    
22. End Sub
    
23. Sub ¼g¤JWork()
    
24.     Dim Rng(1 To 3) As Range, E As Variant, R As Range
    
25.     Set Rng(1) = Sheets("Work").UsedRange.Range("a:a")
    
26.     For Each E In Sheets("Sheet1").Hyperlinks                 'ª«¥ó¶°¦X:¤u§@ªíªº¶W³sµ²¡C
    
27.         Set Rng(2) = Sheets("Sheet1").Range(E.SubAddress)     '¨î©w: ¶W³sµ²ªºÀx¦s®æ
    
28.         For Each R In Rng(1)
    
29.             If Rng(2).Cells(1) & Rng(2).Cells(1, 2) = R & R.Cells(1, 2) Then '»P¶W³sµ²Àx¦s®æªº¤º®e¬Û¦P
    
30.                 Set Rng(3) = R.CurrentRegion                               '½d³ò¥u¦³AB¨âÄæ
    
31.                 'CurrentRegion ÄÝ©Ê ¶Ç¦^ Range ª«¥ó¡A¸Óª«¥ó¥Nªí¥Ø«eªº°Ï°ì¡C¥Ø«e°Ï°ì¬O«ü¥H¥ô·NªÅ¥Õ¦C¤ÎªÅ¥ÕÄ檺²Õ¦X¬°Ãä¬Éªº½d³ò¡C°ßŪ¡C
    
32.                 Rng(2).CurrentRegion.Copy                                    '½Æ»s:¶W³sµ²Àx¦s®æªº³sÄò½d³ò
    
33.                 Rng(3)(1).Insert Shift:=xlDown                               '´¡¤J¶K¤W:¶W³sµ²Àx¦s®æªº³sÄò½d³ò
    
34.                 'Rng(3)(1) =>  Rng(3).Cells(1, 1)                            '½d³òªº²Ä¤@­Ó·¡åJ®æ
    
35.                 Set Rng(3) = Rng(3).Range("A1:C" & Rng(3).Rows.Count)        '¦h¼W¥[¤@Äæ«O«ù¸ê®Æªº§¹¾ã©Ê (CÄæ¤]­n§R°£)
    
36.                 Rng(3).Delete Shift:=xlUp                                    '§R°£: ¤U¤èÀx¦s®æ¤W²¾
    
37.                 Exit For
    
38.             End If
    
39.         Next
    
40.     Next
    
41.     Set Rng(1) = Sheets("Sheet1").[A:A].Find("END", lookat:=xlWhole)   '[SHEET1]AÄ椤´M§ä: "END"
    
42.     Set Rng(1) = Sheets("Sheet1").Range("A1:C" & Rng(1).Row)           '¨î©w½d³ò: AÄæ¨ìCÄæ "END"ªº¦C¸¹
    
43.     Rng(1).Copy Sheets("Work").Cells(Sheets("Work").Rows.Count, 1).End(xlUp)
    
44.     MsgBox "§¹¦¨"
    
45. End Sub

½Æ»s¥N½X