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

[µo°Ý] Äæ¦ì¤º®e¥]§tABC¤å¦r§PÂ_

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-9-19 10:07 ½s¿è

¦^´_ 1# jackyliu


    ÁÂÁ«e½úµoªí¦¹¥DÃD
VBA¤è¦¡¨Ñ°Ñ¦Ò
«á¾Ç¤µ¤Ñ±Ëªñ¨D»·
1.½m²ßÅܼƦW°Ñ¼Æ¤Æ
2.§ó¿Ëªñ¦r¨å

«á¾Ç«Ü·Q¾Ç²ß¤£¤@¼Ëªº§Þ¥©! ¥ýÁÂÁ¦U¦ì«e½úÀ°­q¥¿¿ù»~¨Ã¦A«ü¾É!
  1. Option Explicit
  2. Sub Äæ¦ì¤º®e¥]§tABC¤å¦r§PÂ_()
  3. 'BÄæ¿é¤J®É¼Æ,CÄæ§e²{²Ö¥[«á®É¶¡
  4. 'AÄæ¥]§tABC,¦bDÄæ="¤Wñ"
  5. 'AÄæ¥]§tADEM,¦bDÄæ="¤Uñ"
  6. 'AÄ椣¥]§tABC¥B¤£¥]§tADEM,¦bDÄæ="²¤¹L"
  7. 'AÄæ¥]§tABC¥B¥]§tADEM,¦bDÄæ="¤Wñ+¤Uñ"
  8. Dim Arr, i, Y, Z(1 To 3)
  9. Set Y = CreateObject("Scripting.Dictionary")
  10. Y = Array("¤Wñ", "¤Uñ", "²¤¹L")
  11. Arr = [A2].CurrentRegion
  12. For i = 2 To UBound(Arr)
  13.    Z(1) = Arr(i, 2) / 24 + Arr(i - 1, 3)
  14.    Z(2) = InStr(Arr(i, 1), "ABC")
  15.    Z(3) = InStr(Arr(i, 1), "ADEM")
  16.    Arr(i, 3) = IIf(Arr(i, 2), Z(1), "")
  17.    If Z(2) <> 0 And Z(3) <> 0 Then
  18.       Arr(i, 4) = Y(0) & "+" & Y(1)
  19.       ElseIf Z(2) = 0 And Z(3) = 0 Then
  20.          Arr(i, 4) = Y(2)
  21.       ElseIf Z(3) = 0 Then
  22.          Arr(i, 4) = Y(0)
  23.       Else
  24.          Arr(i, 4) = Y(1)
  25.    End If
  26. Next
  27. [A2].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
  28. End Sub
½Æ»s¥N½X

TOP

¦^´_ 6# jackyliu


    ÁÂÁ«e½ú
¤µ¤é²ß±o
iferror() , LOOKUP() , SEARCH()
¼ÒÀÀ±¡¹Ò½m²ß°}¦C&¦r¨å
VBA¤è¦¡¨Ñ°Ñ¦Ò

§PÂ_TEST-20220926_1.zip (30.99 KB)



TOP

¦^´_ 12# jackyliu


    ÁÂÁ«e½ú¦^Âзs»Ý¨D
¼ÒÀÀ»Ý¨D±¡¹Ò°µ¦¨½d¨Ò,½Ð«e½ú¸Õ¸Õ¬Ý!
¤µ¤Ñ²ß±o VBA¦hÄæ·j´MÃöÁä¦r±a¤J¹ïÀ³­È
½m²ß°}¦C»P¦r¨å
§PÂ_TEST-20221003-A.zip (36.45 KB)
­ì©l:


ÃöÁä¦r¤u§@ªí


µ²ªG:

TOP

¦^´_ 14# jackyliu


    ÁÂÁ«e½ú¦A¦^ÂÐ
«á¾Ç²q¿ù»Ý¨D!¬Ý³o¦¸¬O§_¾A¦X!
¤µ¥Ð²ß±o ¦hÄæ¤å¦rÀx¦s®æ,¦UÄæ±a¤J¦U¦ÛªºÃöÁä¦r·j´M¨ìªº­È!
½m²ß°}¦C»P¦r¨å!
§PÂ_TEST-20221004-_2.zip (40.63 KB) \
­ì©l:


ÃöÁä¦r¤u§@ªí:


µ²ªG:

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-10-4 09:38 ½s¿è

¦^´_ 14# jackyliu


    ¾Ç²ß¤ß±o¦p¤U¨Ñ«e½ú°Ñ¦Ò
¤]½Ð¦U¦ì«e½ú«ü¥¿!ÁÂÁ¦U¦ì«e½ú!
Option Explicit
Sub ·j´MÃöÁä¦r() '¡÷¡ô¡ö¡õ
Application.ScreenUpdating = False
'¡ô°õ¦æ®É¿Ã¹õµe­±¤£­n¸òµÛÅÜ°Ê

Dim Arr, Brr, Crr, i, x, d, xD, T, q$, f$, n, xA, s, v, SD, SS&
'¡ô«Å§iÅܼÆ
T = Timer
'¡ô¥OT=²{¦b®É¶¡

Set xA = Sheets("ÃöÁä¦r").Cells
'¡ôxA=ÃöÁä¦rªº©Ò¦³Àx¦s®æ

Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD ¬O¦r¨å

SD = Array(, 1, 4, 7, 10, 13, 16) '@@
'¡ô¥OSD¬O¤@ºû°}¦C

For s = 1 To Columns.Count Step 2
'¡ô³]©w°j°és±q 1 ¨ì¾ã­Ó¤u§@ªíªº³Ì«á¤@Äæ,¨C¶¦^¨Ó¤@¦¸s­n+2

   If xA(1, s) = "" Then
   '¡ô·í²Ä1¦CªºsÄæ¬OªÅ®æ!
   
      GoTo 101
      '¡ô±ø¥ó¦¨¥ß´N¸õ¨ì 101 ªº¼Ð¥Ü¦ì¸m
      
   End If
   SS = (s + 1) / 2
   '¡ô¥OSS ¬O­n«ü¦V SD°}¦C ªº¦ì¸m,·ís¬O1®ÉSS=1,¬O«ü¦V¤W¤è@@ªº1
   '¡ô,·ís¬O3®ÉSS=3,¬O«ü¦V¤W¤è@@ªº4

   
   Arr = Range(Cells(2, SD(SS)), Cells(Rows.Count, SD(SS)).End(3))
   '¡ô§âÀx¦s®æ­È­Ë¤J Arr°}¦C ¸Ì
   '¡ô·ís¬O1®É,Arr°}¦C ¸Ì©ñªº¬O[A2:A101]

   
   ReDim Crr(1 To UBound(Arr), 1 To 1)
   '¡ô«Å§i Crr°}¦Cªº¤j¤p!Áa¤è¦V¬O1 ¨ì(Arr°}¦CÁa¦V¼Æ¶q),¾î¤è¦V¬O1Äæ)
   
   Brr = xA.Range(xA(1, s), xA(Rows.Count, s + 1).End(3))
  '¡ô§âÀx¦s®æ­È­Ë¤J Brr°}¦C ¸Ì
   '¡ô·ís¬O1®É,¨ì¶i¥hªº¬OSheets("ÃöÁä¦r").[A1:B10]

   
   xD.RemoveAll
   '¡ô²MªÅxD¦r¨å
   
   For d = 2 To UBound(Brr)
   '¡ô³]©w°j°é,±q2 ¨ì Brr°}¦CÁa¦V¼Æ¶q
   
       xD(Brr(d, 1)) = Brr(d, 2)
       '¡ô·íd=2 ¦r¨åªºkey="ABC",item="¤W¤WÅÒ"
      
   Next
   For i = 1 To UBound(Arr)
   '¡ô³]©w°j°é,±q1 ¨ì Arr°}¦CÁa¦V¼Æ¶q
   
      For Each x In xD.Keys
      '¡ô¥Ox¬O¦r¨å¸Ìªº¤@¤À¤l,°j°é±q¦r¨å¸Ìªº²Ä1­Ókey¶}©l¹B¥Î
      ',¨C¶¦^¨Ó´NÅܦ¨²Ä2­Ókey.....

      
         q = UCase(Arr(i, 1))
         '¡ô¥Oq¦r¦ê¬OArr°}¦Cªº­È(¥B¤p¼g­^¤å¦r¥À³£Åܤj¼g),¨Ò¦p UCase("NHjoOa")="NHJOOA"
         
         f = UCase(x)
         '¡ô¥Of¦r¦ê¬OxD.Key(¥B¤p¼g­^¤å¦r¥À³£Åܤj¼g)
         
         n = Len(x)
         '¡ô¥On¬OxD.Keyªº¦r¼Æ
         
         If InStr(q, f) <> 0 Then
         '¡ô¦pªGq¦r¦ê¸Ì¥]§t¤Ff¦r¦ê,f¦r¦ê¦bq¦r¦êªº²Ä´X­Ó¦r¦ì¸m,¨Ò¦p InStr("ABCD", "CD")=3
         
            Crr(i, 1) = xD(x)
            '¡ô¦pªG¤W¤è±ø¥ó¦¨¥ß!´N¥OCrr°}¦C¸Ë¤J key¬Ox ªºitem xD(x)
            
            Cells(i + 1, SD(SS)).Characters(InStr(q, f), n).Font.ColorIndex = 3
            '¡ô¦pªG¤W¤è±ø¥ó¦¨¥ß!´N§â¦rÅܬõ¦â
            
            Exit For
            '¡ô¦pªG¤W¤è±ø¥ó¦¨¥ß!´N¸õ¥X (For Each x In xD.Keys)³o­Ó°j°é
         End If
      Next
   Next
   v = Array(, 2, 5, 8, 11, 14, 17)(SS)
   '¡ô¥Ov¬O¤@ºû°}¦C!¬O¥Î¨Ó«ü©wÃöÁä¦r©Ò·j´M¨ìªº­È­n©ñ­þ¸Ì
   
   Cells(2, v).Resize(UBound(Crr), 1) = Crr
   '¡ô·ís=1®É §âCrr­Ë¤J¤u§@ªí[B2:B101]
   
   Cells(1, v) = Brr(1, 2)
   '¡ô·ís=1®É [B1]="ÅÒ§O"
   
Next

101
MsgBox "¦@¯Ó®É: " & Timer - T

Application.ScreenUpdating = True
'¡ô¿Ã¹õµe­±«ì´_ÅÜ°Ê
End Sub

TOP

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


    ÁÂÁ«e½ú
¤½¦¡¦nÃø,°}¦C¤½¦¡§óÃø,«á¾Ç¬ã¨s¤F¤@¾ã¤Ñ,ÃjÃjÀ´À´
Àµ½Ð«ü¥¿«ü¾É,ÁÂÁÂ
§PÂ_TEST_20221216_2.zip (9.11 KB)

¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤Hªº¤ß¦a¬O¤@²¥¥Ð¡A¤g¦a¨S¦³¼½¤U¦nºØ¤l¡A¤]ªø¤£¥X¦nªºªG¹ê¡C -
ªð¦^¦Cªí ¤W¤@¥DÃD