ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦C¥X§ó¦hªº¹ïÀ³¸ê®Æ

¥»©«³Ì«á¥Ñ jcchiang ©ó 2020-8-21 07:59 ½s¿è

¦^´_ 9# qaqa3296

¦pªG¬O¦r¦ê¥ª¥kªºªÅ®æ,¥i¨Ï¥ÎTrim¥h°£
Trim¡G§R°£¦r¦ê¥ª¡B¥k¨âºÝªÅ¥Õ
Set Rg = .Find(Left(Trim(a.Offset(, 2)), 8) & "*", , , xlWhole)

TOP

¦^´_ 9# qaqa3296
  1. Sub zz()
  2. Dim a, d As Object, b, n&
  3. a = Sheets(1).Range("a2:d" & Sheets(1).[a1048576].End(3).Row)
  4. Set d = CreateObject("scripting.dictionary")
  5. With CreateObject("vbscript.regexp")
  6.     .Pattern = "[-\.\s]+"
  7.     .Global = True
  8.     For i = 1 To UBound(a)
  9.         If Len(a(i, 3)) = 0 Then a(i, 3) = Trim(a(i, 1))
  10.         a(i, 3) = Trim(a(i, 3))
  11.         k = Split(.Replace(a(i, 3), "|"), "|")
  12.         If UBound(k) > 0 Then k = k(0) & "-" & k(1) Else k = a(i, 3)
  13.         d(k) = ""
  14.     Next
  15.     k = Join(d.keys, "|")
  16.     .Pattern = k
  17.     a = Sheets(2).[a1].CurrentRegion
  18.     b = a: n = 1
  19.     For i = 2 To UBound(a)
  20.         If Len(a(i, 3)) > 0 Then k = a(i, 3) Else k = a(i, 1)
  21.         If .TEST(k) Then
  22.              n = n + 1
  23.              For j = 1 To UBound(a, 2)
  24.                 b(n, j) = a(i, j)
  25.              Next
  26.         End If
  27.     Next
  28.     Workbooks.Add 1
  29.     [a1].Resize(n, 4) = b
  30. End With
  31. End Sub
½Æ»s¥N½X

TOP

¦^´_ 9# qaqa3296


¤£¤F¸Ñ¤Ö¸ê®Æ¬O¦ó·N???
®Ú¾Ú´y­z, ±N³W®æ 231-215-??? ²Ä¤T¦r¸`¥h°£, °µ¬°¥t¤@¤ñ¹ï±ø¥ó,
¤å¦r«e«á­Y§t¦³ªÅ¥Õ¦r¤¸, ®M¤@­ÓTRIM(ARR(i,3)) §Y¥i~~
100-1001.3.V1 ³o­Ó¬O§_ÁÙ­n¨ú¥X 100-1001 °µ¬°±ø¥ó,
¦h¦C¥X´X­Ó¤£¦P«¬¦¡ªº³W®æ¤å¦r, ¤Î¨äºI¨ú³W«h~~~

©ÎªÌ, ³W®æªº«e8½X¬°©T©w¦@¥Î, ¤§«áªº¬°ÅܤƧÎ, ³£µø¬°¬Û¦P???

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2020-8-21 18:16 ½s¿è

¦^´_ 9# qaqa3296
§Úªº¼gªk¤ñ¸û²³æ ¦ý¬O·|¤ñ¸ûºC §A¬Ý¬Ý¬O¤£¬O§A­nªº  ¦pªG¬O¤å¦r §A´N¥´¤å¦r ¦C¦p ·Ù¨® ¥Î²Ä¤G­Ó ¦pªG¬O ­ì¥»ªº ªÅ®æ §A´N¥Î²Ä¤@­Ó

javascript:;

¦C¥X§ó¦h¸ê®Æ.rar (20.27 KB)

TOP

¥»©«³Ì«á¥Ñ qaqa3296 ©ó 2020-8-21 20:58 ½s¿è

¦^´_n7822123
¦pjcchiang©Ò»¡¬O¨â°¼¦r¦êªÅ®æ

·PÁÂjcchiang¸É¥R·sªº»yªk

§Ú¨ú±o¸ê®Æ®É¡A³W®æÄæ³Q·í§@³Æµù¡A¥´¤F¤@°ï¤º®e¡A§R±¼¨º¨Ç°T®§¡A«h¥X²{¨â°¼¦r¦êªÅ®æ³Ì¬°±`¨£¡A­ì¥»·Q»¡¬O¤£¬O­n¥ý¥ÎVLOOKUP¥h§ó·s³W®æªº¤º®e¡AÅý¸ê®Æ¤£·|¦]¤H¤u¥´±o¿ù»~¦h¤FªÅ¥Õµ¥µ¥..

¬Ý¨Ó¤]­n§ó·s¤@¤U«ä¦Ò¼Ò¦¡¤F


¦^´_­ã´£³¡ªL
§Ú¤@¶}©l¨S¦³ª`·N¨ìÁÙ¦³¨ä¥L³W®æ¡A¦p­ã´£³¡ªL²q´úªº¤@¼Ë

­è­è¥ÎLEN¨ç¼ÆÀˬd¤@¤U

¤T­Ó¦r¸`"-"¥|­Ó¦r¸`°µ¬°±ø¥ó®ÄªG¡AÀ³¸Ó¥i¥H±o¨ì§ó²z·Qªº¸ê®Æ ¡A¦A¨Ó¤~¬O¨ú8½X¡A8½X¥H¤Uªº±N·|¦C¥X¤j¶q¦h¾l¸ê®Æ¡A©Ò¥H¤£»Ý¦A«Ø¥ß·sªº³W«h¡A´N§ïµ{¦¡6~8½X½ü¬y¥Î§Y¥i

·PÁ¦U¦ì¤j¤jªºÀ°¦£¡A¦³¾Ç¨ì·sªº¨Æª«¡Aı±o¶}¤ß

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-8-21 22:54 ½s¿è

¦^´_ 15# qaqa3296


§Aªº"¼Ò½k¤ñ¹ï" ³W«h¯u½ÆÂø¡A6~8½X½ü¬y¥Î?

¤°»ò®É­Ô¥Î6½X¼Ò½k¤ñ¹ï¡A¤°»ò®É­Ô¥Î8½X¼Ò½k¤ñ¹ï? ¦³¨S¦³7½X¤ñ¹ï?

¼gµ{¦¡Á¿¨s "ÅÞ¿è"¡A§AÅÞ¿èµ¹ªº¤£²M¤£·¡¡A§O¤H¥u¯à½M¤lºN¶H!

¦p­ã¤j©Ò»¡¡A§AÀ³¸Ó§â"©Ò¦³" ³W®æªº®æ¦¡³q³q¦C¥X¨Ó¡A¨Ã¥ÎÃC¦â°Ï¤À¡A­n¥H­þ¨Ç¦r¤¸¨Ó"¼Ò½k¤ñ¹ï"

¤£µM¥H§Aªº"¤å¦r±Ô­z" ÅÞ¿è¡A·|¨S§¹¨S¤F ! ¤U­±³o¥y¸Ü¡A»¡¹ê¸Ü¡A§Ú´N¯uªº¬Ý¤£À´!!!

¤T­Ó¦r¸`"-"¥|­Ó¦r¸`°µ¬°±ø¥ó®ÄªG¡AÀ³¸Ó¥i¥H±o¨ì§ó²z·Qªº¸ê®Æ

Á|¨Ò¨Ó»¡¡A¤U­±¬õ¦â³¡¤À¬O­n¼Ò½k¤ñ¹ïªº³¡¤À¡A¬õ¦â³¡¤À¤@¼Ë«hµø¬°¤@¼Ë

§ÚÀH«K¦C2ºØ¡A½Ð§A§â"©Ò¦³"®æ¦¡¦C¥X¡A¦p¤U°Ñ¦Ò

A02-A001-E

99-A001-A

µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦pªG§A¥u¬O ­nÁקKÅý§O¤H¥´¿ù ¨º§A´N¥Î¦Û­qªí³æ ¤ñ¸û¦n§a...

TOP

¥»©«³Ì«á¥Ñ qaqa3296 ©ó 2020-8-22 00:32 ½s¿è

¦^´_ 16# n7822123

»¡ªº¼Ò¼Ò½k½k¯uªº«Ü©êºp

ªþ¤W¹Ï¤ù


³Ì¤W­±¨º¨Ç«Ü²Ó¡A¥i¯à·|¦C¥X¹L¦h·N·Q¤£¨ìªº¸ê®Æ¡C

TOP

¦^´_ 18# qaqa3296
¬õ¦â³¡¤À¬O§Aªº·j´M¥Ø¼Ð¶Ü? ¦pªG¬O §A¥i¥H¥ÎÃöÁä¦r¿z¿ï ¤ñ¸û²³æ ¦pªGµ²ªG¤£¬O§A­nªº §A¥i¥H§â "" & x & "*" §ï¦¨§A­nªº¤è¦¡
Public Sub ¼Ò½k¿z¿ï()
Range(Cells(2, 1), Cells(2, 4).End(xlDown)).Font.Color = RGB(255, 0, 0)
Application.ScreenUpdating = False
G = True
Sheets(3).Select
Sheets(3).Range(Cells(1, 6), Cells(1, 9).End(xlDown)).Clear
Sheets(2).Select
For K = 2 To Cells(2, 5).End(xlDown).Row
    x = Cells(K, 5)
    For i = 2 To Cells(2, 3).End(xlDown).Row '¨Ì±ø¥ó¿z¿ï

        If Cells(K, 5) = "" Then
           Cells(i, 1).AutoFilter Field:=3, Criteria1:="="
           Range(Cells(2, 1), Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
        Else
           Cells(i, 1).AutoFilter Field:=3, Criteria1:="" & x & "*"
           Range(Cells(2, 1), Cells(2, 4).End(xlDown)).Font.Color = RGB(0, 0, 0)
        End If
        
        If G = True Then
           Range(Cells(1, 1), Cells(1, 4).End(xlDown)).Copy Sheets(3).Cells(1, 6)
           G = False
        Else
           Range(Cells(2, 1), Cells(2, 4).End(xlDown)).Copy Sheets(3).Cells(1, 6).End(xlDown).Offset(1, 0)
        End If
        Cells(2, 3).AutoFilter
    Exit For
    Next i
Next K
Sheets(3).Select
Range(Cells(2, 6), Cells(2, 9).End(xlDown)).Font.Color = RGB(0, 0, 0)
Application.ScreenUpdating = True
End Sub

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-8-22 03:21 ½s¿è

¦^´_ 18# qaqa3296


½T©w´N³o4ºØ®æ¦¡ºO?  ´N¥Î§A³o4ºØ®æ¦¡¶i¦æ¼Ò½k¤ñ¹ï~

¦pªG­n²K¥[¨ä¥L®æ¦¡¦b»¡ ¡A§Ú·Q§A¬Ý¤F§Úªºµ{¦¡¤]¥i¥H¦Û¤v§ï¤F

³o¸Ì«Ü¦h¤H³£¥i¥HÀ°§A§¹¦¨¡A¥u­n§AÅÞ¿è±Ô­z°÷²M·¡!

²³æªºªF¦è¨S¥²­n·d½ÆÂø¡A§Úªºµ{¦¡ÅÞ¿è¦p¤U


1.¨Ì4ºØ®æ¦¡ªº³W®æÄæ¦ì¥h¬d¸ß®w¦s¡A¶i¦æ¼Ò½k¤ñ¹ï
2. ³W®æÄæ¦ì­Y¦³ªÅ¥Õ¦r¤¸¡A«h²¾°£ªÅ¥Õ¦r¤¸¦A¤ñ¹ï
3.­Y«D¦¹4ºØ®æ¦¡¡A«h¨Ì«~¸¹§ì¸ê®Æ(³æµ§)¡A¤£¼Ò½k¤ñ¹ï
4.¬d¸ßªº¸ê®Æ¦C¨ì¤u§@ªí"¦¨ªG"


µ{¦¡¦p¤U

Sub ¼Ò½k¬d¸ß()
Dim Rg As Range, ¬d§ä½d³ò As Range, ¦¹ªí As Object
Dim Arr, R&, Key$, MD$, Csft&, K2$, Addr0$, R1&
[¦¨ªG!A1].CurrentRegion.Offset(1).ClearContents
Arr = Range([D1], [A1].End(4))
Set ¦¹ªí = ActiveSheet: Sheets("¦¨ªG").Activate
R1 = 1: [A1:D1] = Array("«~¸¹", "«~¦W", "³W®æ", "¼Æ¶q")
For R = 2 To UBound(Arr)
  MD = Replace(Arr(R, 3), " ", "")   '²¾°£ªÅ¥Õ(¤£ºÞ¦b­þ­Ó¦ì¸m)
  Key = ""
  If MD Like "####*" Then Key = Left(MD, 4)
  If MD Like "[A-Z]####*" Then Key = Left(MD, 5)
  If MD Like "###-####*" Then Key = Left(MD, 8)
  If MD Like "[A-Z]##-[A-Z]###*" Then Key = Left(MD, 8)
  If Key <> "" Then  '­Y³W®æ²Å¦X¤W­z4ºØ®æ¦¡¡A«h¼Ò½k¬d¸ß
    Set ¬d§ä½d³ò = [®w¦s!C:C]: Csft = -2: K2 = "*"
  Else '­Y³W®æ¤£²Å¦X¤W­z4ºØ®æ¦¡¡A§ï¬d«~¸¹(¶È³æµ§)
    Set ¬d§ä½d³ò = [®w¦s!A:A]: Csft = 0: K2 = "": Key = Arr(R, 1)
  End If
  With ¬d§ä½d³ò
    Set Rg = .Find(Key & K2, , , xlWhole)
      If Not Rg Is Nothing Then Addr0 = Rg.Address
      Do While Not Rg Is Nothing
          R1 = R1 + 1
          Rg.Resize(, 4).Offset(, Csft).Copy Cells(R1, "A")
          Set Rg = .FindNext(Rg)
          If Rg.Address = Addr0 Then Exit Do
      Loop
  End With
Next R
End Sub


Àɮצp¤U

¦C¥X§ó¦h¸ê®Æ0822.rar (19.34 KB)
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

        ÀR«ä¦Û¦b : ¤@­Ó¯Ê¤fªºªM¤l¡A¦pªG´«¤@­Ó¨¤«×¬Ý¥¦¡A¥¦¤´µM¬O¶êªº¡C
ªð¦^¦Cªí ¤W¤@¥DÃD