[µo°Ý] ¬d¸ß«á¶Ç¦^¦hµ§¸ê®Æ¥H¾ðª¬¥Ø¿ý¤è¦¡¸m©ñ

jesscc

¤u§@¦³ÂI½ÆÂø¡A¦bªþÀɤ¤¦³¸Ô²Ó»¡©ú

test.rar (29.82 KB)

¤U¸ü¦¸¼Æ: 22

2011-10-21 21:48

jesscc

¤w­×¥¿¿ù§R¼ÐÃD¦Cªº°ÝÃD¡A¨Ã¥B¤]¥i¥H¬d¸ß¤F¡A¥u¬O¬d¸ßµ²ªG¤£²Å©Ò»Ý¡A¥u¯à¶Ç¦^³Ì«á¤@µ§

1. Sub query1()
   
2. Dim i%, Ar(), A As Range
   
3. If [E13] <> "" Then
   
4.      Columns("G:I").EntireColumn.Hidden = True
   
5.      Range([E13], Cells(Rows.Count, 5).End(xlUp)).SpecialCells(xlCellTypeConstants).EntireRow.Delete
   
6. AA:
   
7. Set d = CreateObject("Scripting.Dictionary")
   
8. Set d1 = CreateObject("Scripting.Dictionary")
   
9. 
   
10.     With Sheets("OpenOrder")
    
11.         For Each A In Range(.[E7], .[E65536].End(xlUp))
    
12.             d(A.Value) = A.Offset(, 2).Value
    
13.             d1(A.Value) = Array(A.Value, A.Offset(, 1).Value, "", "", "", A.Offset(, 5).Value, "", "", A.Offset(, 8).Value, A.Offset(, 9).Value, A.Offset(, 10).Value, A.Offset(, 11).Value, A.Offset(, 12).Value)
    
14.         Next
    
15.     End With
    
16.     With Sheets("B")
    
17.         For Each A In Range(.[D12], .[D65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
    
18.            For Each ky In d.keys
    
19.               If ky = A Then
    
20.               ReDim Preserve Ar(s)
    
21.               Ar(s) = d1(ky)
    
22.               s = s + 1
    
23.               End If
    
24.            Next
    
25.            
    
26.            If s > 0 Then
    
27.            A.Offset(1, 0).Resize(s, 1).EntireRow.Insert
    
28.            A.Offset(1, 1).Resize(s, 13) = Application.Transpose(Application.Transpose(Ar))
    
29.            s = 0: Erase Ar
    
30.            End If
    
31.         Next
    
32.     End With
    
33. 
    
34. 
    
35. Set d = Nothing
    
36. Set d1 = Nothing
    
37. Else
    
38. GoTo AA
    
39. End If
    
40. End Sub

½Æ»s¥N½X

jesscc

¦^´_ 2# Hsieh


    ·PÁÂH¤jÀ°¦£!
µ{¦¡¹B§@¤j­POK¡A§R°£¦Cªº®É­Ô¦³ÂI¤p°ÝÃD¡A§Ú§â­ì©lÀÉSub query()ªº³¡¤À°µ¤F¤@¨Ç­×§ï¡A¥[¤J¤FOpenOrderªº¬d¸ß¡A¥»¨ÓÁÙ·Q»¡À³¸Ó¤£Ãø¡A¦]¬°³o­Ó³¡¤À¤£¥Î¦Ò¶q±Æ°£­ì©lPNªº°ÝÃD¡A¥u¦³¸ê®Æ©ñ¸mªº°ÝÃD¡C§Ú¥ÎCallªº¤è¦¡¡A¦b¤@­ÓSub¸Ì¥hCall¤£¦Pªº¬d¸ß¡Aµ²ªGOpenOrderªº³¡¤ÀµLªk¥¿±`¬d¸ß(°»¿ù:¦¹³B»Ý­nª«¥ó)¡A¦Ó¥B¦pªG¤@ª½«ö"¬d¸ß"«ö¶s¡A·|³s¼ÐÃD¦C³£³Q§R°£¡A¤£ª¾­þ¸Ì¦³°ÝÃD¡A§ÖºÆ¤F><

test1.rar (57.12 KB)

¤U¸ü¦¸¼Æ: 13

2011-10-22 14:08

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