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

[µo°Ý] ½Ð°Ý¦U¦ì«e½úÃö©óFind »P¤ñ¹ïRange °ÝÃD

[µo°Ý] ½Ð°Ý¦U¦ì«e½úÃö©óFind »P¤ñ¹ïRange °ÝÃD

¤£¦n·N«ä¡B½Ð°Ý«e½ú¤@¤U~¤p§Ì¦³¤@¥÷¸ê®Æ±¡ªp¦p¤U¡G
1.¤ñ¹ïdata   2.¨Ó·½data  3.Á`¾ã²z

¸ê®Æ¬°¨Ï¥Îvba ¥h´M§ä"¤ñ¹ïdata"³Ì«á¤@µ§ªº("A~D")ªº¸ê®Æ¡A
¥h®Ö¹ïsheet"¨Ó·½data"¤¤("A~D")ªº¸ê®Æ¦pªG¦³§¹¥þ¬Û²Åªº´N±qsheet"¨Ó·½data"¤¤±N¸Ó¦Cªº¸ê®Æcopy¨ìsheet"Á`¾ã²z"¡C
¦]¤p§Ì¨Ï¥ÎFind¡B¦ý«o¥d¦b³o¦¸»Ý´M§ä¬O¤@­Ó°Ï¶ô¦Ó«D³æ¤@¦r¦ê©ÎÀx¦s®æ¤º®e¡A
©Ò¥H½Ð«e½ú¯à¤£¯à«ü¾É¤@¤U¤p§Ì±µ¤U¨Ó¸Ó¦p¦ó§ï¼g¡H

·PÁÂ~

find »P¤ñ¹ïRange «á±NÄæ¦ìcopy¨ì¬YÄæ .rar (16.33 KB)

¦^´_ 13# GBKEE

GBKEE«e½ú~¤£¦n·N«ä¡K«á¨Ó¤p§Ì¹Á¸Õ¦b¶}±ÒÀɮ׫e¥[¤W"Application.DisplayAlerts = False 'Ãö³¬©Ò¦³EXCELµ{§Ç¨t²Î´£¥Ü"¤§«á´N¥i¥H¥¿±`­È¦æ¤F¡A
¯u¬O¤£¦n·N«ä³o»ò³Â·Ð±z¡C
   

·PÁ«e½ú«e´X¬qªº«ü¾É~

TOP

¦^´_ 13# GBKEE

¤£¦n·N«ä GBKEE«e½ú¡A¦]¤p§Ì¤u§@Ãö«Y»Ý®M¥Î©ó§O³B¡B½Ð°Ý¦pªG¨Ó·½¸ê®Æwb(2)¶}°_®É¥X²{¦p¤U¹Ïªº( µLªk§ó·sªº³sµ²)¡A
½Ð°Ý¸Ó¦p¦ó±N¨Ó·½¸ê®Æªº¦Û°Ê§ó·sÃö³¬©O¡H

µù¡G¤p§Ìª¦¤å¹Á¸Õ¨Ï¥Î»y¥y2¨ÓÃö³¬¨Ó·½¸ê®Æĵ§i¡B¦ý¥i¯à¥d¦b»y¥y1¤w¸g¥ý¶}±Ò¡A©Ò¥HÁ`¬O¥X²{¿ù»~±¡ªp¡C

»y¥y1¡G Set wb(2) = Workbooks.Open(Worksheets("¸ô®|°Ï").Cells(2, 3) & "\" & Worksheets("¸ô®|°Ï").Cells(2, 2))  '¨Ï¥Î©ó¥t¤@­Óexcel sheet(¨Ó·½data)
»y¥y2¡GWorkbooks.Open Filename:="D:\¶g§O¸ê®Æ\wk1432\find ¤ñ¹ï°ÝÃD\find »P¤ñ¹ïRange °ÝÃD3 - ¨Ó·½data.xlsm" ,UpdateLinks:=0

TOP

¦^´_ 13# GBKEE


    ·PÁÂGBKEE«e½ú«ü¾É¡B¦]¬°¤p§Ìªº¸ê®Æ¨Ó·½¤j¦h¬°°Ïºô¤Wªº¦@¥Îexcel data¡A
    ·|¨Ï¥Î¨Ò¤l1¦]¾á¤ß¥i¯à¨Ó·½data¤w¥ý³Q¨ä¥¦¤H¶}±Ò·|¦³¶}±Òĵ§i°ÝÃD¡A
    ¸g«e½ú´£¿ô«á¡B¤p§Ì¹ê»Ú¥h´ú¸Õ¨Ï¥Î¨Ò¤l2¡B§Y¨Ï¦³¤H¶}°_¨Ó·½data¤]¦ü¥G¤£¼vÅTµ{¦¡ªº¹B¦æ¡A
    ¦b¦¹ÁÂÁ«e½úªº«ü¾ÉÅo~

¨Ò¤l1¡G' Dim myApp As New Application  '¬°¦ó­n·s¶} Excel
¨Ò¤l2¡GSet wb(2) = Workbooks.Open

TOP

¦^´_ 12# ii31sakura
  1. Dim myApp As New Application
  2. With wb(2).Sheets("¨Ó·½data").Range("A:A")                           '½d³ò:³o¤u§@ªíªºAÄæ
  3. Set Rng(2) = .Find(Rng(1).Value, AFTER:=.Cells(1), LookIn:=xlFormulas) '·j´M¤é´Á:­n¥Î¤½¦¡LookIn:=xlFormulas
½Æ»s¥N½X
Rng(2) is nothing µLªk¬ð¯}

¸Õ¸Õ¤£·s¶} Excel À³¥Îµ{¦¡
  1. Sub Ex3()
  2.     Dim Rng(1 To 3) As Range, Rng2_Address As String
  3.     Dim wb(1 To 2) As Workbook
  4.    ' Dim myApp As New Application  '¬°¦ó­n·s¶} Excel
  5.     Set wb(1) = ThisWorkbook '¨Ï¥Î©ósheet(¤ñ¹ïdata)
  6.     'Set wb(2) = myApp.Workbooks.Open(Worksheets("¸ô®|°Ï").Cells(2, 3) & "\" & Worksheets("¸ô®|°Ï").Cells(2, 2))  '¨Ï¥Î©ó¥t¤@­Óexcel sheet(¨Ó·½data)
  7.     Set wb(2) = Workbooks.Open(Worksheets("¸ô®|°Ï").Cells(2, 3) & "\" & Worksheets("¸ô®|°Ï").Cells(2, 2))  '¨Ï¥Î©ó¥t¤@­Óexcel sheet(¨Ó·½data)
  8.     Set Rng(1) = wb(1).Worksheets("¤ñ¹ïdata").Range("A2")                    '¤ñ¹ïdataªº²Ä¤@µ§¸ê®Æ(¤é´Á)
  9.     Do While Rng(1) <> ""                                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
  10.         With wb(2).Sheets("¨Ó·½data").Range("A:A")                           '½d³ò:³o¤u§@ªíªºAÄæ
  11.             Set Rng(2) = .Find(Rng(1).Value, AFTER:=.Cells(1), LookIn:=xlFormulas) '·j´M¤é´Á:­n¥Î¤½¦¡LookIn:=xlFormulas
  12.             Do While Not Rng(2) Is Nothing                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
  13.                 If Rng2_Address = "" Then Rng2_Address = Rng(2).Address '°O¿ý²Ä¤@¦¸§ä¨ìªº¦ì¸m
  14.                 If Rng(1).Cells(1, 2) = Rng(2).Cells(1, 2) Then     '
  15. '                    Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3)             '¤ñ¹ïªº²Ä¤GÄæ=¨Ó·½dataªº²Ä¤GÄæ
  16.                   
  17.                    ' Rng(1).Cells(1, 3) = Rng(2).Row '¦¹¬q¬°§ä¸Ó¸ê®Æªºrow
  18.                    '******************
  19.                     If Rng(3) Is Nothing Then
  20.                         Set Rng(3) = Rng(2).Resize(, 3)
  21.                     Else
  22.                     
  23.                         Set Rng(3) = Union(Rng(3), Rng(2).Resize(, 3))
  24.                     End If
  25.                     '*********************
  26.                     Exit Do
  27.                 End If
  28.                 Set Rng(2) = .FindNext(Rng(2))                          'Ä~Äò©¹¤U·j´M
  29.                 If Rng2_Address = Rng(2).Address Then                   '¦^¨ì²Ä¤@¦¸§ä¨ìªº¦ì¸m
  30.                     Exit Do                                             'Â÷¶}°j°é
  31.                 End If
  32.             Loop
  33.             Rng2_Address = ""
  34.             Set Rng(1) = Rng(1).Offset(1)                               '¤ñ¹ïdataªº¤U¤@µ§¸ê®Æ(¤é´Á)
  35.         End With
  36.     Loop
  37.     If Not Rng(3) Is Nothing Then
  38.          With wb(1).Worksheets("Á`¾ã²z")
  39.             .UsedRange.Offset(1) = ""
  40.             Rng(3).Copy .Range("A2")
  41.         End With
  42.     End If
  43.        wb(2).Close False
  44.        Set wb(1) = Nothing
  45.         Set wb(2) = Nothing
  46.         Set Rng(1) = Nothing
  47.         Set Rng(2) = Nothing

  48. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 11# GBKEE

·PÁÂGBKEE«e½ú«ü¾É¨â­Ó¤èªk¡BÅý¤p§Ì¥i¥H¦³¦h¤@¼hªÅ¶¡ÅܤơA
¤£¦n·N«ä¦pªG¤p§Ì®M¥Îªº¨Ó·½ºÝÄݩ󤣦Pexcel¡B
¬G¨Ï¥Î¥H¤U¤è¦¡¶i¦æ³]©w¡B¦ý¦ü¥Gº|¤F­þ­ÓÀô¸`¦Ó¾É­PµLªk°õ¦æ¡A
¦]¹Á¸Õ³\¤[µLªk¥¿¸Ñ¡B½Ð°Ý¯à¤£¯à¦A½ÐÀ°¦£¬Ý¤@¤U©O¡H

find »P¤ñ¹ïRange °ÝÃD1.zip (25.65 KB)

µ{¦¡½X¡G
Sub Ex3()
    Dim Rng(1 To 2) As Range, Rng2_Address As String
     Dim wb(1 To 2) As Workbook
    Dim myApp As New Application
   
   
     Set wb(1) = ThisWorkbook '¨Ï¥Î©ósheet(¤ñ¹ïdata)
    Set wb(2) = myApp.Workbooks.Open(Worksheets("¸ô®|°Ï").Cells(2, 3) & "\" & Worksheets("¸ô®|°Ï").Cells(2, 2))  '¨Ï¥Î©ó¥t¤@­Óexcel sheet(¨Ó·½data)
   
    Set Rng(1) = wb(1).Worksheets("¤ñ¹ïdata").Range("A2")                    '¤ñ¹ïdataªº²Ä¤@µ§¸ê®Æ(¤é´Á)
    Do While Rng(1) <> ""                                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
        With wb(2).Sheets("¨Ó·½data").Range("A:A")                           '½d³ò:³o¤u§@ªíªºAÄæ
            Set Rng(2) = .Find(Rng(1), AFTER:=.Cells(1), LookIn:=xlFormulas) '·j´M¤é´Á:­n¥Î¤½¦¡LookIn:=xlFormulas
            Do While Not Rng(2) Is Nothing                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
                If Rng2_Address = "" Then Rng2_Address = Rng(2).Address '°O¿ý²Ä¤@¦¸§ä¨ìªº¦ì¸m
                If Rng(1).Cells(1, 2) = Rng(2).Cells(1, 2) Then     '
'                    Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3)             '¤ñ¹ïªº²Ä¤GÄæ=¨Ó·½dataªº²Ä¤GÄæ
                    
                    Rng(1).Cells(1, 3) = Rng(2).Row '¦¹¬q¬°§ä¸Ó¸ê®Æªºrow
                    
                    Exit Do
                End If
                Set Rng(2) = .FindNext(Rng(2))                          'Ä~Äò©¹¤U·j´M
                If Rng2_Address = Rng(2).Address Then                   '¦^¨ì²Ä¤@¦¸§ä¨ìªº¦ì¸m
                    Exit Do                                             'Â÷¶}°j°é
                End If
            Loop
            Rng2_Address = ""
            Set Rng(1) = Rng(1).Offset(1)                               '¤ñ¹ïdataªº¤U¤@µ§¸ê®Æ(¤é´Á)
        End With
    Loop
   
   
       wb(2).Close False
        
        
        Set wb(1) = Nothing
        Set wb(2) = Nothing
        Set Rng(1) = Nothing: Set Rng(2) = Nothing
'        Set findvalue = Nothing
End Sub

TOP

¦^´_ 10# ii31sakura
  1. Option Explicit
  2. Sub Ex()
  3.     Dim d As Object, Rng As Range, S As String
  4.     Set d = CreateObject("scripting.dictionary")
  5.     Set Rng = Sheets("¤ñ¹ïdata").Range("A2")
  6.     Do While Rng <> ""
  7.         d(Rng & Rng.Cells(1, 2) & Rng.Cells(1, 3)) = ""
  8.         Set Rng = Rng.Cells(2, 1)
  9.     Loop
  10.     Set Rng = Sheets("¨Ó·½data").Range("A2")
  11.     Do While Rng <> ""
  12.         If d.EXISTS(Rng & Rng.Cells(1, 2) & Rng.Cells(1, 3)) Then
  13.             If d.EXISTS("¤ñ¹ï¨ì") Then
  14.                 Set d("¤ñ¹ï¨ì") = Union(Rng.Resize(, 3), d("¤ñ¹ï¨ì"))
  15.             Else
  16.                 Set d("¤ñ¹ï¨ì") = Rng.Resize(, 3)
  17.             End If
  18.         
  19.             S = IIf(S <> "", S & vbLf, "") & Rng.Address(0, 0) & " §ä¨ì " & Rng & "-" & Rng.Cells(1, 2) & "-" & Rng.Cells(1, 3)
  20.         End If
  21.         Set Rng = Rng.Cells(2, 1)
  22.     Loop
  23.     If S <> "" Then
  24.         d("¤ñ¹ï¨ì").Parent.Activate
  25.          d("¤ñ¹ï¨ì").Select
  26.         MsgBox "¨Ó·½data " & vbLf & S
  27.     End If
  28. End Sub
  29. Sub Ex3()
  30.     Dim Rng(1 To 2) As Range, Rng2_Address As String
  31.     Set Rng(1) = Worksheets("¤ñ¹ïdata").Range("A2")                    '¤ñ¹ïdataªº²Ä¤@µ§¸ê®Æ(¤é´Á)
  32.     Sheets("¨Ó·½data").UsedRange.Offset(1).Interior.ColorIndex = xlNone
  33.     Do While Rng(1) <> ""                                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
  34.         With Sheets("¨Ó·½data").Range("A:A")                           '½d³ò:³o¤u§@ªíªºAÄæ
  35.             Set Rng(2) = .Find(Rng(1), AFTER:=.Cells(1), LookIn:=xlFormulas) '·j´M¤é´Á:­n¥Î¤½¦¡LookIn:=xlFormulas
  36.             Do While Not Rng(2) Is Nothing                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
  37.                 If Rng2_Address = "" Then Rng2_Address = Rng(2).Address '°O¿ý²Ä¤@¦¸§ä¨ìªº¦ì¸m
  38.                 If Rng(1).Cells(1, 2) = Rng(2).Cells(1, 2) And Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3) Then      '
  39. '                     Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3)             '¤ñ¹ïªº²Ä¤GÄæ=¨Ó·½dataªº²Ä¤GÄæ
  40.                     
  41.                     Rng(1).Cells(1, 4) = Rng(2).Row '¦¹¬q¬°§ä¸Ó¸ê®Æªºrow
  42.                     Rng(2).Resize(, 3).Interior.Color = vbYellow
  43.                     
  44.                     Exit Do
  45.                 End If
  46.                 Set Rng(2) = .FindNext(Rng(2))                          'Ä~Äò©¹¤U·j´M
  47.                 If Rng2_Address = Rng(2).Address Then                   '¦^¨ì²Ä¤@¦¸§ä¨ìªº¦ì¸m
  48.                     Exit Do                                             'Â÷¶}°j°é
  49.                 End If
  50.             Loop
  51.             Rng2_Address = ""
  52.             Set Rng(1) = Rng(1).Offset(1)                               '¤ñ¹ïdataªº¤U¤@µ§¸ê®Æ(¤é´Á)
  53.         End With
  54.     Loop
  55. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 8# GBKEE

©êºp¡BGBKEE«e½ú¡K¯à§_¦A½Ð«ü¾ÉªþÀɤ¤¦pªG¤ñ¹ï±ø¥ó¯à§_±q¨â­Ó¤ñ¹ï±ø¥óÅܧ󬰤T­Ó¤ñ¹ï±ø¥ó©O¡H
¦]¤p§Ì¥t¤@­ÓÀÉ®×µo²{¨â­Ó¤ñ¹ï±ø¥ó¥i¯à·|¸I¨ì­«ÂЩʱ¡ªp¡B¦pªG¨Ï¥Î¤T­Ó¤ñ¹ï±ø¥ó´N¤£·|¦³­«Âб¡ªp¡A
¯à§_½Ð°Ý¥i©ó¦ó³B¶i¦æ­×§ï©O¡H
¤£¦n·N«ä¤F...


    find »P¤ñ¹ïRange °ÝÃD1.rar (18.02 KB)

Sub Ex3()
    Dim Rng(1 To 2) As Range, Rng2_Address As String
    Set Rng(1) = Worksheets("¤ñ¹ïdata").Range("A2")                    '¤ñ¹ïdataªº²Ä¤@µ§¸ê®Æ(¤é´Á)
    Do While Rng(1) <> ""                                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
        With Sheets("¨Ó·½data").Range("A:A")                           '½d³ò:³o¤u§@ªíªºAÄæ
            Set Rng(2) = .Find(Rng(1), AFTER:=.Cells(1), LookIn:=xlFormulas) '·j´M¤é´Á:­n¥Î¤½¦¡LookIn:=xlFormulas
            Do While Not Rng(2) Is Nothing                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
                If Rng2_Address = "" Then Rng2_Address = Rng(2).Address '°O¿ý²Ä¤@¦¸§ä¨ìªº¦ì¸m
                If Rng(1).Cells(1, 2) = Rng(2).Cells(1, 2) Then     '
'                    Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3)             '¤ñ¹ïªº²Ä¤GÄæ=¨Ó·½dataªº²Ä¤GÄæ
                    
                    Rng(1).Cells(1, 4) = Rng(2).Row '¦¹¬q¬°§ä¸Ó¸ê®Æªºrow
                    
                    Exit Do
                End If
                Set Rng(2) = .FindNext(Rng(2))                          'Ä~Äò©¹¤U·j´M
                If Rng2_Address = Rng(2).Address Then                   '¦^¨ì²Ä¤@¦¸§ä¨ìªº¦ì¸m
                    Exit Do                                             'Â÷¶}°j°é
                End If
            Loop
            Rng2_Address = ""
            Set Rng(1) = Rng(1).Offset(1)                               '¤ñ¹ïdataªº¤U¤@µ§¸ê®Æ(¤é´Á)
        End With
    Loop
End Sub

TOP

¦^´_ 8# GBKEE

«D±`·PÁÂGBKEE«e½ú~¯u¬O¦ò¤ß¨Óªº¡A«e½úÁÙÀ°¦£¨C¬q¥Îµù¸Ñ¡B¯u·PÁÂ~

TOP

¦^´_ 7# ii31sakura
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex2()
  3.     Dim Rng(1 To 2) As Range, Rng2_Address As String
  4.     Set Rng(1) = Worksheets("¤ñ¹ïdata").Range("A2")                    '¤ñ¹ïdataªº²Ä¤@µ§¸ê®Æ(¤é´Á)
  5.     Do While Rng(1) <> ""                                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
  6.         With Sheets("¨Ó·½data").Range("A:A")                           '½d³ò:³o¤u§@ªíªºAÄæ
  7.             Set Rng(2) = .Find(Rng(1), AFTER:=.Cells(1), LookIn:=xlFormulas) '·j´M¤é´Á:­n¥Î¤½¦¡LookIn:=xlFormulas
  8.             Do While Not Rng(2) Is Nothing                              '°õ¦æ¨ì±ø¥ó¤£¦¨¥ß
  9.                 If Rng2_Address = "" Then Rng2_Address = Rng(2).Address '°O¿ý²Ä¤@¦¸§ä¨ìªº¦ì¸m
  10.                 If Rng(1).Cells(1, 2) = Rng(2).Cells(1, 2) Then     '
  11.                     Rng(1).Cells(1, 3) = Rng(2).Cells(1, 3)             '¤ñ¹ïªº²Ä¤GÄæ=¨Ó·½dataªº²Ä¤GÄæ
  12.                     Exit Do
  13.                 End If
  14.                 Set Rng(2) = .FindNext(Rng(2))                          'Ä~Äò©¹¤U·j´M
  15.                 If Rng2_Address = Rng(2).Address Then                   '¦^¨ì²Ä¤@¦¸§ä¨ìªº¦ì¸m
  16.                     Exit Do                                             'Â÷¶}°j°é
  17.                 End If
  18.             Loop
  19.             Rng2_Address = ""
  20.             Set Rng(1) = Rng(1).Offset(1)                               '¤ñ¹ïdataªº¤U¤@µ§¸ê®Æ(¤é´Á)
  21.         End With
  22.     Loop
  23. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¸Ü¦h¤£¦p¸Ü¤Ö¡A¸Ü¤Ö¤£¦p¸Ü¦n¡C
ªð¦^¦Cªí ¤W¤@¥DÃD