ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð±Ð¦p¦ó´M§ä»·ºÝºÏºÐ¤¤excelÀɮפu§@ªíµ²ªG

[µo°Ý] ½Ð±Ð¦p¦ó´M§ä»·ºÝºÏºÐ¤¤excelÀɮפu§@ªíµ²ªG

½Ð±Ð¦U¦ì¤j¤j:
§Ú¦b¤u§@¤W¦³¤@­Ó»·ºÝ¤½¥ÎºÏºÐ
­n¥Î¦óºØ¤è¦¡¥i¥HÅý¤j®a³£¥h¬d¸ß¤½¥ÎºÏºÐ¤W¬Y­ÓexcelÀÉ®×
¶i¦Ó±a¥X¦U¤u§@ªí¤¤©Ò»Ý­nªº´M§ä¥Ø¼Ð

A.rar (151.39 KB) ¦^´_ 1# chengtoo

TOP

RE: ½Ð±Ð¦p¦ó´M§ä»·ºÝºÏºÐ¤¤excelÀɮפu§@ªíµ²ªG

name.rar (15.44 KB) ¤U­±°ò¥»¤W¥i¥H¥N´À§Ú­nªºµ²ªG
¥u¬O·Q½Ð¦U¦ì¤j¤jÀ°¦£¬Ý¤@¤U
¦pªG§Ú­nªºµ²ªG¤£¬O­n¥H³sµ²ªºÅã¥Ü¦Ó¬O­nª½±µ¨q¥Xµ²ªG¸Ó«ç»ò­×§ï

¥t¥~°²³]¨S¦¬´M¥Xµ²ªG ·|¤@ª½¥X²{¿ù»~¦b ³Ì«á­±ªº End If ½ÐÀ°¦£¬Ý¬Ý



Sub QuickSearch()
  Dim wks As Excel.Worksheet
  Dim rCell As Excel.Range

  Dim szLookupVal As String
  szLookupVal = InputBox("key in", "key in msg", "")

  
  If szLookupVal = "" Then Exit Sub

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

  
    For Each wks In ActiveWorkbook.Worksheets
      If wks.Name = "Result" Then
        wks.Delete
      End If
    Next wks

    Sheets.Add ActiveSheet

    ActiveSheet.Name = "Result"

    With Cells(1, 1)
      .Value = "¤U­±¤]¦³©Ò»Ý­n¸ê°T" & szLookupVal
      .EntireColumn.AutoFit
      .HorizontalAlignment = xlCenter
    End With

    ActiveSheet.Next.Select


    i = 2

    For Each wks In ActiveWorkbook.Worksheets

      With wks.Cells
        Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)
        If Not rCell Is Nothing Then
          szFirst = rCell.Address
          Do
         
            rCell.Hyperlinks.Add Sheets("Result").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
         
             Select Case bTag
                    Case True
                       rCell.Interior.ColorIndex = 19
             End Select
             Set rCell = .FindNext(rCell)
             i = i + 1
          Loop While Not rCell Is Nothing And rCell.Address <> szFirst
        End If
      End With
    Next wks


    Set rCell = Nothing


    If i = 2 Then
      MsgBox "©Ò­n¬d§äªº­È{" & szLookupVal & "}¦b¤u§@ªí¤¤¨S¦³", 64, "§ä¤£¨ì³á"
     
      
      End If
Application.ScreenUpdating = True
     Application.DisplayAlerts = True
   
End Sub

TOP

¦^´_ 3# chengtoo
¨S·j´M¥Xµ²ªG ·|¤@ª½¥X²{¿ù»~¦b ³Ì«á­±ªº End If  °õ¦æ«á¨S³o¿ù»~
¸Õ¸Õ¬Ý ­×§ï¬O§A©Ò»Ý¶Ü?
  1. Sub QuickSearch()
  2.     Dim wks As Excel.Worksheet
  3.     Dim rCell As Excel.Range
  4.     Dim szLookupVal As String
  5.     szLookupVal = InputBox("key in", "key in msg", "")
  6.     If szLookupVal = "" Then Exit Sub
  7.     Application.ScreenUpdating = False
  8.     'Application.DisplayAlerts = False
  9.     On Error GoTo Sheet_add        'µ{¦¡½X¦³¿ù»~:GoTo(¨ì) Sheet_add Ä~Äò°õ¦æµ{¦¡½X
  10.     With Sheets("Result").Cells    '¤u§@ªí¤£¦s¦b·|¦³¿ù»~
  11.         .Clear
  12.         .Cells(1) = "¤U­±¤]¦³©Ò»Ý­n¸ê°T" & szLookupVal
  13.         .EntireColumn.AutoFit
  14.         .HorizontalAlignment = xlCenter
  15.     End With
  16.     On Error GoTo 0                 'µ{¦¡½X¦³¿ù»~:¤£³B¸Ì->¹w¨¾¦³¤£ª¾ªº¿ù»~¥i¦A­×¥¿µ{¦¡½X
  17.     i = 2
  18.     For Each wks In ActiveWorkbook.Worksheets
  19.         If wks.Name = "Result" Then Exit For
  20.         With wks.Cells
  21.             Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)
  22.             If Not rCell Is Nothing Then
  23.                 szFirst = rCell.Address
  24.                 Do
  25.                     With Sheets("Result")
  26.                         .Cells(i, 1) = wks.Name & "'!" & rCell.Address
  27.                         .Cells(i, 2) = rCell
  28.                     End With
  29.                     rCell.Interior.ColorIndex = 19
  30.                     Set rCell = .FindNext(rCell)
  31.                     i = i + 1
  32.                 Loop While Not rCell Is Nothing And rCell.Address <> szFirst
  33.             End If
  34.         End With
  35.     Next wks
  36.     Set rCell = Nothing
  37.     Sheets("Result").Activate
  38.     If i = 2 Then MsgBox "©Ò­n¬d§äªº­È{" & szLookupVal & "}¦b¤u§@ªí¤¤¨S¦³", 64, "§ä¤£¨ì³á"
  39.     Application.ScreenUpdating = True
  40.    ' Application.DisplayAlerts = True
  41.    Exit Sub    'Â÷¶}µ{§Ç-> ¤£¦A°õ¦æ  Sheet_add:¤Uªºµ{¦¡½X
  42. Sheet_add:  'Result¤£¦s¦b®É·s¼W¤u§@ªí
  43.     Sheets.Add ActiveSheet
  44.     ActiveSheet.Name = "Result"
  45.     Resume       '¦^¨ìµ{¦¡½X¿ù»~¦æÄ~Äò°õ¦æµ{¦¡
  46. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 4# GBKEE

GBKEE¤j¤j:
·PÁ±zªº¨ó§U
¥t¥~¦pªG¬O³Ì«á¦¬´Mªºµ²ªG¨S¦³®É§Ú­n§R°£result¤u§@ªí
¬O¤£¬O¥u­n¦b³Ì«á sheets("result").Delete  ??
¦]¬°¥Î³o¼Ëªº¸Ü³£·|¸õ¥X¤@­Óµøµ¡ ½T»{¬O§_§R°£
§Ú·Q­n¦Û°Ê§R°£ªº¸Ü ¤£ª¾¸Ó¦p¦ó§ï

TOP

¦^´_ 5# chengtoo
¹ï©ó¤£¤F¸ÑªºVBA ¨ç¼Æ,¤èªkÄÝ©Ê ,¦h¬Ý»¡©ú·|¶i¨Bªº
  1.       '.....µ{¦¡½X     
  2.      Set rCell = Nothing
  3.     Sheets("Result").Activate
  4.     If i = 2 Then
  5.         Application.DisplayAlerts = False    '°±¤î:¨tªº²Î¸ß°Ýµøµ¡
  6.         MsgBox "©Ò­n¬d§äªº­È{" & szLookupVal & "}¦b¤u§@ªí¤¤¨S¦³", 64, "§ä¤£¨ì³á"
  7.         Sheets("Result").Delete
  8.         Application.DisplayAlerts = True   '«ì´_:¨t²Îªº¸ß°Ýµøµ¡
  9.     End If
  10.     Application.ScreenUpdating = True
  11.    '.....µ{¦¡½X
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

RE: ½Ð±Ð¦p¦ó´M§ä»·ºÝºÏºÐ¤¤excelÀɮפu§@ªíµ²ªG(¤w¸Ñ¨M)

¦^´_ 6# GBKEE
ÁÂÁÂ GBKEE¤j¤j
§Ú·|§V¤O¾Ç²ßªº ·PÁ ¤w¸g¸Ñ¨M

TOP

        ÀR«ä¦Û¦b : ¦n¨Æ­n´£±o°_¡A¬O«D­n©ñ±o¤U¡A¦¨´N§O¤H§Y¬O¦¨´N¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD