starry1314

¦^´_ 10# ­ã´£³¡ªL


   
Sub TEST()
Dim xArea As Range, xR As Range, xU As Range, xD, T$, i&
For i = 1 To 9 Step 4 '½Ð°Ý³o­Ó9ªº·N«ä¬O?  ª¾¹D«á­±ªº4¬O Á`¦@¤@²Õ¥|Äæ¨Ó§R°£
¡@¡@Set xD = CreateObject("Scripting.Dictionary")
¡@¡@Set xArea = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)(1, 4))
¡@¡@For Each xR In xArea
¡@¡@¡@¡@T = xR(1, 2) & xR(1, 3): xD(T) = xD(T) + 1
¡@¡@Next
¡@
¡@¡@Set xU = Cells(xArea.Rows.Count + 2, 1)
¡@¡@For Each xR In xArea
¡@¡@¡@¡@T = xR(1, 2) & xR(1, 3)
¡@¡@¡@¡@If xD(T) >= 20 And xR(1, 4) = "." Then Set xU = Union(xU, xR.Resize(1, 4))
¡@¡@Next
¡@
¡@¡@If xU.Count > 1 Then xU.Delete Shift:=xlUp
Next i
End Sub

starry1314

¦^´_ 10# ­ã´£³¡ªL

ª©¤j~¤£¦n·N«ä ²{Äæ¦ì¦³¼W¥[¡A¸Õ¹L«á§ï¤£¤Ó¥X¨Ó  
¥u·|§R°£³¡¥÷¸ê®Æ ²Ä¤@ªí®æ·|¥þ§R,²Ä¤G¡B¤Tªí®æ¥u·|§R°£³¡¥÷¸ê®Æ
    ¦h±ø¥ó§PÂ_§R°£-2.rar (92.51 KB)

¤U¸ü¦¸¼Æ: 3

2015-11-28 09:37

starry1314

¦^´_ 10# ­ã´£³¡ªL
¥Ø«e§ï¬°³o¼Ë¥i¹F¦¨®ÄªG,¤£ª¾¬O§_¦³¤£§´ªº¦a¤è
Sub ¼ÐÅÒ()
Dim xArea As Range, xR As Range, xU As Range, xD, T$, i&
For i = 1 To 28 Step 9
    Set xD = CreateObject("Scripting.Dictionary")
    Set xArea = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)(1, 8))
    For Each xR In xArea
        T = xR(1, 5) & xR(1, 6): xD(T) = xD(T) + 1
    Next

    Set xU = Cells(xArea.Rows.Count + 2, 1)
    For Each xR In xArea
        T = xR(1, 5) & xR(1, 6)
        If xD(T) >= 20 And xR(1, 8) = "." Then Set xU = Union(xU, xR.Resize(1, 9))
    Next

    If xU.Count > 1 Then xU.Delete Shift:=xlUp
Next i
End Sub

­ã´£³¡ªL

¦^´_ 13# starry1314


Set xArea = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp)(1, 8))¡@¡@

¬õ¦â³¡¥÷½Ð§R±¼¡]¤@®Éµ§»~¡D¨Sµo²{¡^¡I
¨ú¤@­ÓÄæ¦ì§Y¥i¡A¦h¤F¬õ¦â³¡¥÷¡AxArea´NÅܦ¨¢·­ÓÄæ°Ï¡ã¡ã

¨ä¥¦¤j­P¢÷¢ó¡A´N¥u¬Ý¸ê®Æ¬O§_¦³©T©w¬[ºc¡A¤£µM¤]¬OÃø¥H¥¿½T°õ¦æµ{¦¡ªº¡I


¤U¤@¦æ¥i¦Û°Ê°»´ú¡eÄæ¦ì¡f¼Æ¡G
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 9

starry1314

¦^´_ 14# ­ã´£³¡ªL


    ·PÁÂ~§¹¬ü¹F¨ì©Ò­nªº®ÄªG !!
¦Û°Ê°»´úÄæ¦ì¦n¥Î¦h¤F,
¤£¹L¤£À´¬°¦ó²Ä¤@¦¸POªºª©¥»
For i = 1 To 9 Step 4 '¦@¦³12­ÓÄæ¦ì ¦ý¤£ª¾¬°¦ó·|¬O9,¤£¬OÀ³¸Ó¬O12¶Ü

­ã´£³¡ªL

¦^´_ 15# starry1314


¶¡¹j¢³¸õ¤T¦¸¡A¢°¡Ð¢´¡Ð¢¸¡A¦A¸õ¤@¦¸´N¢°¢²¡A©Ò¥H 1 To 9 ©Î 1 To 12 ¦P¼Ë¡ã¡ã

starry1314

¦^´_ 16# ­ã´£³¡ªL
¤F¸Ñ¡I·PÁ«ü¾É¡ã!!

starry1314

¦^´_ 16# ­ã´£³¡ªL

¤j¤j ¤£¦n·N«ä
¤S¹J¨ìÃøÃD¤F......
©³¤U¬°¦UÃþ§Oªº³æ¤@«~¶µ¹F20¥H¤W§Y§R°£,¥B³æ¦ì¥N¸¹¬°Aªº«h§R°£³¡¤ÀÄæ¦ì¸ê®Æ
¶K¯È±ø¥ó=20
xR(1, 10)=³æ¦ì¥N¸¹

¥Ø«eªºÃøÃD¬O...¹F20¥H¤Wªº¼Æ¶q­pºâ¤£¥]§t ³æ¦ì¥N¸¹¤£¬°A
¤£¬°Aªº³æ¦ì«h²Î¤@­pºâ
¦³¸ÕµÛ°µ­×§ï¦ý³o¼Ë¦]¬°³æ¦ì¥N¸¹º¡¦h
  T = xR(1, 5) & xR(1, 6)  §ï¬°¡õ
  T = xR(1, 5) & xR(1, 6) & xR(1, 10)

1. Sub ±ø¥ó§R°£()
   
2. Dim arr, U%
   
3. Dim xArea As Range, xR As Range, xU As Range, xD, T$, I&
   
4. 
   
5. 'For i = 1 To 28 Step 9
   
6. For I = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 10
   
7. '¦Û°Ê°»´úÄæ¦ì¼Æ ¥H9Ä欰¤@²Õ
   
8.     Set xD = CreateObject("Scripting.Dictionary")
   
9.     Set xArea = Range(Cells(2, I), Cells(Rows.Count, I).End(xlUp))
   
10.     For Each xR In xArea
    
11.         T = xR(1, 5) & xR(1, 6): xD(T) = xD(T) + 1
    
12.     Next
    
13. 'Àˬd²Å¦X§R°£±ø¥óªÌ¡A¯Ç¤J xU Àx¦s®æÁp¶°
    
14.     Set xU = Cells(xArea.Rows.Count + 2, 1)
    
15.     For Each xR In xArea
    
16.         T = xR(1, 5) & xR(1, 6)
    
17.         If xD(T) >= [¶K¯È±ø¥ó] And xR(1, 8) = "." And xR(1, 10) = "A" Then Set xU = Union(xU, xR.Resize(1, 3))
    
18.     Next
    
19. '§R°£
    
20.    If xU.Count > 1 Then xU = ""  'xU.Delete Shift:=xlUp
    
21.     'If xU.Count > 1 Then xU.Delete Shift:=xlUp
    
22. Next I
    
23.    
    
24. End Sub

½Æ»s¥N½X

starry1314

¦^´_ 17# starry1314


    ¥Ø«eªº¸Ñ¨M¤è¦¡:±N³æ¦ì¥N¸¹¤£ÄÝ©óAªº½s¸¹ §ï¬°²Î¤@ªº½s¸¹¦A¨Ó°µ¹Bºâ

­ã´£³¡ªL

For Each xR In xArea
¡@¡@If xR(1, 10) = "A" Then
¡@¡@¡@T = xR(1, 5) & xR(1, 6)
¡@¡@¡@xD(T) = xD(T) + 1
¡@¡@End If
Next

«D"A"®É¡A¤£­n³B²z§Y¥i¡I