Hsieh

¦^´_ 1# jesscc
¬d¸ß

1. Sub query()
   
2. Dim i%, Ar(), A As Range
   
3. If Sheet33.OptionButton7.Object.Value = True Then
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Set d1 = CreateObject("Scripting.Dictionary")
   
6.     With Sheets("DATA")
   
7.         For Each A In Range(.[B5], .[B65536].End(xlUp))
   
8.             d(A.Value) = A.Offset(, 3).Value
   
9.             d1(A.Value) = Array(A.Value, "", A.Offset(, 3).Value, A.Offset(, 4).Value, A.Offset(, 10).Value)
   
10.         Next
    
11.     End With
    
12.     With Sheets("B")
    
13.         For Each A In Range(.[D12], .[D65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
    
14.            For Each ky In d.keys
    
15.               If ky <> A And d(ky) = d(A.Value) Then
    
16.               ReDim Preserve Ar(s)
    
17.               Ar(s) = d1(ky)
    
18.               s = s + 1
    
19.               End If
    
20.            Next
    
21.            If s > 0 Then
    
22.            A.Offset(1, 0).Resize(s, 1).EntireRow.Insert
    
23.            A.Offset(1, 1).Resize(s, 5) = Application.Transpose(Application.Transpose(Ar))
    
24.            s = 0: Erase Ar
    
25.            End If
    
26.         Next
    
27.     End With
    
28. End If
    
29. Set d = Nothing
    
30. Set d1 = Nothing
    
31. End Sub

½Æ»s¥N½X

´À¥N®Æ

1. Private Sub OptionButton7_Click()
   
2. Dim i%
   
3. [E11] = "´À¥N®Æ"
   
4. Columns("G:J").EntireColumn.Hidden = False
   
5. Var = MsgBox("³o¼Ë°µ·|§R°£§A¤§«e©Ò°µªº¬d¸ßµ²ªG¡C" & vbCrLf & vbCrLf & "¦ý¤£·|§R°£­ì¨Óªº PN¡C" & vbCrLf & vbCrLf & "½Ð½T©w§A­n¶i¦æªº¬d¸ß¶µ¥Ø !" & vbCrLf & vbCrLf & "¥i¥H«ö""¨ú®ø""Â÷¶}!", 33, "¾Þ§@¨BÆJ´£¥Ü!")
   
6.      If Var = 2 Then
   
7.      OptionButton6 = True
   
8.      Columns("G:J").EntireColumn.Hidden = True
   
9.        Exit Sub
   
10.      Else
    
11.      Range([E12], Cells(Rows.Count, 5).End(xlUp)).SpecialCells(xlCellTypeConstants).EntireRow.Delete
    
12.      End If
    
13.   End Sub

½Æ»s¥N½X