GBKEE

¦^´_ 1# ii31sakura
¸Õ¸Õ¬Ý

1. Sub Ex()
   
2.     Dim Ar(), i As Integer, S As String
   
3.     With Sheets("¤ñ¹ïdata").Range("A" & Sheets("¤ñ¹ïdata").Rows.Count).End(xlUp).Resize(, 4)
   
4.         S = Join(Application.Transpose(Application.Transpose(.Value)), "")
   
5.         '"¤ñ¹ïdata"³Ì«á¤@µ§ªº("A~D")ªº¸ê®Æ
   
6.     End With
   
7.     With Sheets("Á`¾ã²z")
   
8.         .Cells.Clear
   
9.         .Range("A1").Resize(, 7) = Sheets("¨Ó·½data").Range("A1").Resize(, 7).Value     'ªíÀY
   
10.         Ar = Sheets("¨Ó·½data").Range("A1:D5").Value  'sheet"¨Ó·½data"¤¤("A~D")
    
11.         For i = 1 To UBound(Ar)
    
12.             If S = Join(Application.Index(Ar, i), "") Then
    
13.                 .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(, 7) = _
    
14.                     Sheets("¨Ó·½data").Cells(i, "A").Resize(, 7).Value
    
15.             End If
    
16.         Next
    
17.     End With
    
18. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 3# ii31sakura

1. Sub Ex()
   
2.     Dim Ar(), i As Integer, S As String, Rng As Range, ss
   
3.     With Sheets("¤ñ¹ïdata").Range("A" & Sheets("¤ñ¹ïdata").Rows.Count).End(xlUp).Resize(, 4)
   
4.         S = Join(Application.Transpose(Application.Transpose(.Value)), "")
   
5.         '"¤ñ¹ïdata"³Ì«á¤@µ§ªº("A~D")ªº¸ê®Æ
   
6.     End With
   
7.     With Sheets("Á`¾ã²z")
   
8.         .Cells.Clear
   
9.         .Range("A1").Resize(, 7) = Sheets("¨Ó·½data").Range("A1").Resize(, 7).Value     'ªíÀY
   
10.         Ar = Sheets("¨Ó·½data").Range("A1:D5").Value  'sheet"¨Ó·½data"¤¤("A~D")
    
11.         For i = 1 To UBound(Ar)
    
12.             If S = Join(Application.Index(Ar, i), "") Then
    
13.                 Set Rng = Sheets("¨Ó·½data").Cells(i, "A").Resize(, 7)
    
14.                 MsgBox "¦b ²Ä" & i & " ¦C  §ä¨ì " & Join(Application.Transpose(Application.Transpose(Rng.Value)), ",")
    
15.                 .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(, 7) = Rng.Value
    
16.             End If
    
17.         Next
    
18.     End With
    
19. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 6# ii31sakura
­×§ï¬° R => ¥ÑAÄæ³Ì©³³¡©¹¤W¨ì¦³¸ê®ÆÀx¦s®æªº¦C¸¹

1. 'Ar = Sheets("¨Ó·½data").Range("A1:D5").Value  'sheet"¨Ó·½data"¤¤("A~D")
   
2.         With Sheets("¨Ó·½data")
   
3.             R = .Cells(.Rows.Count, "a").End(xlUp).Row
   
4.             Ar = .Range("A1:D" & R).Value 'sheet"¨Ó·½data"¤¤("A~D")
   
5.         End With

½Æ»s¥N½X

GBKEE

¦^´_ 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

GBKEE

¦^´_ 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

GBKEE

¦^´_ 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. 
    
49. End Sub

½Æ»s¥N½X