[µo°Ý] ½Æ»s²Å¦X±ø¥ó¾ã¦C¸ê®Æ

b9208

½Æ»s²Å¦X±ø¥ó¾ã¦C¸ê®Æ
1. ±ø¥ó¡GBÄæ­È=ABC or QWE¤ÎCÄæ­È=AA or BB¤ÎEÄæ­È¤£µ¥©óªÅ®æ
2. ±N¡u¤u§@ªí1¡v²Å¦X±ø¥ó¾ã¦C¸ê®Æ½Æ»s¨ì¡u¤u§@ªí2¡v
3. ¡u¤u§@ªí2¡v¸ê®Æ¨Ì¾ÚAÄæ­È±Æ§Ç¡A¥Ñ¤p¨ì¤j¡C
·q½Ð«ü¾É
ÁÂÁÂ
AB.rar (8.89 KB)

¤U¸ü¦¸¼Æ: 26

2014-5-9 22:50

Hsieh

¦^´_ 1# b9208

1. Sub ex()
   
2. Dim A As Range, Rng As Range
   
3. With ¤u§@ªí1
   
4. Set Rng = .[A1:G1]
   
5. For Each A In .Range("E:E").SpecialCells(xlCellTypeConstants)
   
6.   If (A.Offset(, -3) = "ABC" Or A.Offset(, -3) = "QWE") And (A.Offset(, -2) = "AA" Or A.Offset(, -2) = "BB") Then Set Rng = Union(Rng, A.Offset(, -4).Resize(, 7))
   
7. Next
   
8. With ¤u§@ªí2
   
9. .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Clear
   
10. Rng.Copy .[A3]
    
11. .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Sort key1:=.[A3], Header:=xlYes
    
12. End With
    
13. End With
    
14. End Sub

½Æ»s¥N½X

b9208

¦^´_ 2# Hsieh
Dear Hsieh
«D±`·PÁ±zªº«ü¾É
°õ¦æ¤W¨S¦³°ÝÃD
:)

dou10801

¦^´_ 2# Hsieh ½Ð±Ðª©¥D,¦pªG¬O[¤é´Á°Ï¬q](¤u§@ªí3),¦p¦ó³B²z,·P®¦.

samwang

¦^´_ 4# dou10801

¬O³o¼Ë¶Ü? ½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim Arr, T1, T2
With ¤u§@ªí3
    Set Rng = .[A1:G1]
    T1 = .[j2]: T2 = .[k2]
    Arr = .Range(.[a1], .[g65536].End(3))
    For i = 2 To UBound(Arr)
        If Arr(i, 2) >= T1 And Arr(i, 2) <= T2 Then
        Set Rng = Union(Rng, .Cells(i, 1).Resize(, 7))
        End If
    Next
End With
With ¤u§@ªí2
       .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Clear
       Rng.Copy .[A3]
End With
End Sub

dou10801

¦^´_ 5# samwang samwang«e½ú·P®¦,¥i¥H¹B§@,¨ä¥L©µ¦ù¥\¯à¦Û¦æ´ú¸Õ¾Ç²ß,ÁÂÁÂ.

hcm19522

¦^´_ 6# dou10801


    https://blog.xuite.net/hcm19522/twblog/590018193


https://blog.xuite.net/hcm19522/twblog/590018192

Andy2483

ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C&¦r¨å
¸ê®Æªí:

¤U¸ü (42.64 KB)

2022-12-9 13:26

µ²ªGªí:

¤U¸ü (25.15 KB)

2022-12-9 13:27

Sub TEST()
Dim Brr, C&, R&, T, V$(6), Y, N&
Set Y = CreateObject("Scripting.Dictionary")
Brr = ¤u§@ªí1.UsedRange.Offset(1)
T = Split("ABC,QWE,AA,BB", ",")
For R = 1 To UBound(Brr)
   If (Brr(R, 2) = T(0) Or Brr(R, 2) = T(1)) And (Brr(R, 3) = T(2) Or Brr(R, 3) = T(3)) Then
      If Trim(Brr(R, 5)) <> "" Then
         N = N + 1
         For C = 1 To UBound(Brr, 2)
            V(C - 1) = Brr(R, C)
         Next
         Y(Brr(R, 1) & "|" & R) = V
      End If
   End If
Next
¤u§@ªí2.UsedRange.Offset(3).Clear
With ¤u§@ªí2.[A4].Resize(N, UBound(V))
   .Value = Application.Transpose(Application.Transpose(Y.ITEMS))
   .Sort key1:=.Item(1), Header:=xlNo
End With
Set Brr = Nothing
Set Y = Nothing
Erase T, V
End Sub

Andy2483

¦^´_ 2# Hsieh


    ÁÂÁ«e½ú
¥H¤U¬ã²ß«e½ú¤ß±oµù¸Ñ,½Ð¦A«ü¾É,ÁÂÁÂ

Option Explicit
Sub ex()
Dim A As Range, Rng As Range
'¡ô«Å§iÅܼÆ
With ¤u§@ªí1
'¡ô¥H¤UÃö©ó¤u§@ªí1 µ{§Ç
Set Rng = .[A1:G1]
'¡ô¥ORng ¬Oªí¤@ªº[A1:G1]Àx¦s®æ
For Each A In .Range("E:E").SpecialCells(xlCellTypeConstants)
'¡ô³]¶¶°j°é¥OA¬O EÄæ«DªÅ®æÀx¦s®æªº¨ä¤¤¤@®æ,¥Ñ«e¶]¨ì«á
  If (A.Offset(, -3) = "ABC" Or A.Offset(, -3) = "QWE") And (A.Offset(, -2) = "AA" Or A.Offset(, -2) = "BB") Then
  '¡ô¦pªGAÀx¦s®æ©¹¥ªÃä²¾3Ä檺Àx¦s®æ­È¬O"ABC",©ÎÀx¦s®æ­È¬O"QWE",
  '¦Ó¥BAÀx¦s®æ©¹¥ªÃä²¾2Ä檺Àx¦s®æ­È¬O"AA",©ÎÀx¦s®æ­È¬O"BB"
     Set Rng = Union(Rng, A.Offset(, -4).Resize(, 7))
     '¡ô¥ORng³oÀx¦s®æÅܼƬO ­ìRngÀx¦s®æ¶°¦A²K¤J (AÀx¦s®æ©¹¥ª°¾²¾4®æ¶}©lÂX®i:
     'Áa¦V¤£¦AÂX®i,¥u¾î¦V©¹¥kÂX®i7Äæ)ªºÀx¦s®æ½d³ò
  End If
Next
With ¤u§@ªí2
'¡ô¥H¤UÃö©ó¤u§@ªí2 µ{§Ç
   .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Clear
   '¡ô¤u§@ªí2 [A3]¨ì (±q[A3]©¹¤U§ä¨ìªº³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ)ªºÀx¦s®æ¶°,
   '©¹¥k°¾²¾6Ä檺Àx¦s®æ²M°£
   Rng.Copy .[A3]
   '¡ô±NRng Àx¦s®æ¶°½Æ»s¨ì ¤u§@ªí2[A3]¶}©lªº½d³ò,
   'ÁöµM¥Ø¼ÐÀx¦s®æ¶°¥i¯à¬O¶¡Â_¦C,¦ý½Æ»s©óµ²ªGªí·|©¿²¤ªÅ¥Õªº¾ã¦C,©¹¤W»¼¸É
   .Range(.[A3], .[A3].End(xlDown).Offset(, 6)).Sort key1:=.[A3], Header:=xlYes
   '¡ô¤u§@ªí2 [A3]¨ì (±q[A3]©¹¤U§ä¨ìªº³Ì«á¤@­Ó¦³¤º®eªºÀx¦s®æ)ªºÀx¦s®æ¶°,
   '°µ±Æ§Ç!Áa¦V,°ò·ÇÄæ¦ì¬OAÄæ,¦³¼ÐÃD¦C
End With
End With
End Sub

Andy2483

¦^´_ 8# Andy2483


    ¦^´_¦Û¤vªº²Ê¤ß¤j·N
Sub TEST()
Dim Brr, C&, R&, T, V$(6), Y, N&
'¡ô«Å§iÅܼÆ(Brr,T,Y)¬O³q¥Î«¬ÅܼÆ,(C,R,N)¬Oªø¾ã¼Æ,V¬O¤@ºû°}¦CV(0)~V(6)
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY¬O¦r¨å
Brr = ¤u§@ªí1.UsedRange.Offset(1)
'¡ô¥OBrr¬O°}¦C!­Ë¤J ¤u§@ªí1¦³¨Ï¥ÎÀx¦s®æªº³Ì¤p¤è¥¿°Ï°ì©¹¤U°¾²¾ 1¦CÀx¦s®æ ­È
T = Split("ABC,QWE,AA,BB", ",")
'¡ô¥OT¬O¥H","²Å¸¹©î¸ÑÂù¤Þ¸¹¤ºªº¦r¦ê¤@ºû°}¦C
'¯Á¤Þ¸¹0:"ABC" ;1:"QWE" ;2:"AA" ;3:"BB"
For R = 1 To UBound(Brr)
'¡ô³]¥~¶¶°j°é!R±q1¨ìBrr°}¦CÁa¦V³Ì¤j¦C¸¹
   If (Brr(R, 2) = T(0) Or Brr(R, 2) = T(1)) And (Brr(R, 3) = T(2) Or Brr(R, 3) = T(3)) Then
   '¡ô¦pªG(°j°é¦C²Ä2ÄæBrr°}¦C­È¬O"ABC ©Î °j°é¦C²Ä2ÄæBrr°}¦C­È¬O"QWE"),
   '¦Ó¥B(°j°é¦C²Ä3ÄæBrr°}¦C­È¬O"AA ©Î °j°é¦C²Ä3ÄæBrr°}¦C­È¬O"BB")
      If Trim(Brr(R, 5)) <> "" Then
      '¡ô¦A¦pªG°j°é¦C²Ä5ÄæBrr°}¦C­È¬OªÅ¦r¤¸
         N = N + 1
         '¡ôN¼Æ¦rÅܼƲ֥[ 1
         For C = 1 To UBound(Brr, 2)
         '¡ô³]¤º¶¶°j°é!C±q1¨ì Brr°}¦C¾î¦V³Ì¤jÄ渹
            V(C - 1) = Brr(R, C)
            '¡ô¥OBrr°}¦CªºR°j°é¦CC°j°éÄæ­È±a¤JV¤@ºû°}¦C¬Û¹ï¦ì¸m¸Ì
         Next
         Y(Brr(R, 1) & "|" & R) = V
         '¡ô¥O¥HR°j°é¦C²Ä1ÄæBrr°}¦C­È³s±µ "|" ²Å¸¹,¦A³s±µR°j°é¼Æ ¬°key,
         'item¬OV¤@ºû°}¦C
      End If
   End If
Next
¤u§@ªí2.UsedRange.Offset(3).Clear
'¡ô¥O ¤u§@ªí2¦³¨Ï¥ÎÀx¦s®æªº³Ì¤p¤è¥¿°Ï°ì©¹¤U°¾²¾ 3¦CÀx¦s®æ²M°£
With ¤u§@ªí2.[A4].Resize(N, UBound(V) + 1)
'¡ô¦A¦¸½Æ²ß¤~Àˬd¨ìÄæ¼ÆÀ³¸Ó­n¥[ 1,¦]¬°UBound(V)«üªº¤£¬O°}¦C³Ì¤j¤¸¯À¼Æ!¬O³Ì¤j¯Á¤Þ¸¹
'¥H¤U¦³Ãö©ó ¤u§@ªí2.[A4]¦V¤UÂX®iN¦C,¦V¥kÂX®iV¤@ºû°}¦C³Ì¤j¯Á¤Þ¸¹¼Æ+1 ªº½d³òÀx¦s®æ
   .Value = Application.Transpose(Application.Transpose(Y.ITEMS))
   '¡ôÂX®i½d³òÀx¦s®æªº­È¥HY¦r¨åªºitemÂà¸m«á­Ë¤J
   .Sort key1:=.Item(1), Header:=xlNo
   '°µ±Æ§Ç!Áa¦V,°ò·ÇÄæ¦ì¬OÂX®i°Ï°ìªº²Ä 1Äæ,¨S¦³¼ÐÃD¦C
End With
Set Brr = Nothing
Set Y = Nothing
Erase T, V
'¡ôÄÀ©ñÅܼÆ
End Sub

¸ê®Æªí:

¤U¸ü (34.82 KB)

2022-12-12 11:14

With ¤u§@ªí2.[A4].Resize(N, UBound(V))

¤U¸ü (25.15 KB)

2022-12-12 11:14

With ¤u§@ªí2.[A4].Resize(N, UBound(V) + 1)

¤U¸ü (25.55 KB)

2022-12-12 11:15