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

[µo°Ý] ²Å¦X¦h±ø¥ó±a¥X¬ÛÃö¸ê°T

[µo°Ý] ²Å¦X¦h±ø¥ó±a¥X¬ÛÃö¸ê°T

½Ð±Ð¦U¦ì¤j¤j¡G
¦p¦ó¥u¿é¤J¬P´Á«á¥i¦Û°Ê±a¥X©Ò¦³¸ê®Æ©Î¿é¤J¬P´Á¤Î«È¤á²ºÙ¥i±a¥X¬ÛÃö¸ê®Æ¡C

¬¡­¶Ã¯1.rar (9.64 KB)

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-21 15:25 ½s¿è

¦^´_ 1# 013160


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨ÒÀÉ®×
«á¾ÇÂǦ¹¥DÃD¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¦ý¤£ª¾¬O§_²Å¦X«e½ú±¡¹Ò»Ý¨D,½Ð¸Õ¸Õ¬Ý

¿é¤Jµ¡: ¹w¥ý¸m¤J¤µ¤Ñ¤é´Á


«ö½T©w«á:


¿é¤J: 12/22


¿é¤J: 12/23


µ{¦¡½X¦p¤U:

Option Explicit
Sub ²Å¦X¦h±ø¥ó±a¥X¬ÛÃö¸ê°T_20221221_1()
Dim Arr(4), Brr, Crr, i&, Y, T
Dim Sh As Worksheet, Da, N&, j%, We
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = ActiveSheet
Brr = Range(Sh.[A1], Sh.UsedRange)
Da = InputBox("½Ð¿é¤J ¤é´Á!", "²Å¦X¦h±ø¥ó±a¥X¬ÛÃö¸ê°T", Date)
If Not IsDate(Da) Then Exit Sub
We = Right(Format(Da, "aaaa"), 1)
T = Array(5, 1, 2, 3, 4)
For i = 2 To UBound(Brr)
   If Trim(Brr(i, 3)) = "" Then Exit For
   If InStr(Brr(i, 3), We) Then
      If N = 0 Then
         Crr = Arr
         For j = 0 To UBound(T)
            Crr(j) = Brr(1, T(j))
         Next
         N = N + 1
         Y(N) = Crr
      End If
      N = N + 1
      Crr = Arr
      For j = 0 To UBound(T)
         Crr(j) = Brr(i, T(j))
      Next
      Y(N) = Crr
   End If
Next
If N = 0 Then Exit Sub
Workbooks.Add
[A2].Resize(N, UBound(Arr) + 1) = Application.Transpose(Application.Transpose(Y.ITEMS))
Range([A1], ActiveSheet.UsedRange).Borders.LineStyle = 1
Cells.Columns.AutoFit
[2:2].Font.Bold = True
[A1].NumberFormatLocal = "m""¤ë""d""¤é"";@"
[A1] = Da: [B1] = We
Set Y = Nothing
Set Brr = Nothing
Erase Crr, Arr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

B13//
=RIGHT(TEXT(A13,"aaa"))  A13¿é¤J¤é´Á, ¦Û°ÊÅÜ´«¬P´Á

A15//°}¦C¤½¦¡(¤TÁä¦P«ö)
=iferror(INDEX($A:$E,SMALL(IF(1-ISERR(0/(FIND($B$13,"/"&$C$2:$C$9)-1)),ROW($2:$9)),ROW(A1)),MATCH(A$14,$1:$1,))&"","")
¥k©Ô//¤U©Ô

TOP

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


    ÁÂÁ«e½ú«ü¾É
B13//
=RIGHT(TEXT(A13,"aaa"))  A13¿é¤J¤é´Á, ¦Û°ÊÅÜ´«¬P´Á

1.±N[A13]­ÈÂà´«¬°¶g¤G,¦A¨ú¨ä³Ì¥kÃ䪺²Ä1­Ó¦rÅã¥Ü¦b[B13]¦¹Àx¦s®æ
1.1.TEXT(): ¥H®æ¦¡¥N½X¨Ó®M¥Î®æ¦¡¡AÂǦ¹Åܧó¼Æ¦rÅã¥Üªº¤è¦¡
=TEXT(A13,"aaa")¡÷  ¶g¤G
https://support.microsoft.com/zh-tw/office/text-%E5%87%BD%E6%95%B8-20d5ac4d-7b94-49fd-bb38-93d29371225c

1.2.=RIGHT("¶g¤G")¡÷  ¤G
§¹¾ã¤è¦¡ =RIGHT("¶g¤G",1) ¦pªG¬Ù²¤ 1¡A«h·|°²³]¨ä­È¬° 1
https://support.microsoft.com/zh-tw/office/right-rightb-%E5%87%BD%E6%95%B8-240267ee-9afa-4639-a02b-f19e1786cf2f
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-23 15:49 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«ÜÃø



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

TOP

¦^´_ 2# Andy2483


    ½Æ²ß¤F¤@¤U,¤ß±oµù¸Ñ,½Ð«e½ú­Ì«ü¾É
Option Explicit
Sub ²Å¦X¦h±ø¥ó±a¥X¬ÛÃö¸ê°T_20221221_1()
Dim Arr(4), Brr, Crr, Da, Y, T, We
Dim Sh As Worksheet, i&, N&, j%
'¡ô«Å§iÅܼÆ:Arr¬O¤@ºû°}¦C,±qArr(0)~Arr(4),(Brr,Crr,Da,Y,T,We)¬O³q¥Î«¬ÅܼÆ,
'Sh¬O¤u§@ªíÅܼÆ,(i, N)¬Oªø¾ã¼Æ,j¬Oµu¾ã¼Æ

Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY¬O ¦r¨å
Set Sh = ActiveSheet
'¡ô¥OSh¤u§@ªíÅܼƬO ²{¥Î¤u§@ªí(²{ªí)
Brr = Range(Sh.[A1], Sh.UsedRange)
'¡ô¥OBrr¬O ¤Gºû°}¦C!¥H²{ªí[A1]¨ì ²{ªí¸Ì¦³¨Ï¥Î®æ,³o½d³òÀx¦s®æ­È­Ë¤J
Da = InputBox("½Ð¿é¤J ¤é´Á!", "²Å¦X¦h±ø¥ó±a¥X¬ÛÃö¸ê°T", Date)
'¡ô¥ODa³o³q¥Î«¬ÅܼƬOInputBox()¨ç¦¡¦^¶Ç­È
If Not IsDate(Da) Then Exit Sub
'¡ô¦pªG¥HIsDate()¨ç¦¡§PÂ_DaÅܼƤ£¬O¤é´Á!µ²§ôµ{§Ç°õ¦æ
We = Right(Format(Da, "aaaa"), 1)
'¡ô¥OWe³o³q¥Î«¬ÅܼƬO DaÅܼƥÎFormat()Âà¤Æ¬°¤å¦r(¬P´Á?),¦A¥ÎRight()¨ú¥X³Ì¥kÃ䪺¦r
T = Array(5, 1, 2, 3, 4)
'¡ô¥OT³o³q¥Î«¬ÅܼƬO¤@ºû°}¦C,­Ë¤J5­Ó¼Æ¦r
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ
   If Trim(Brr(i, 3)) = "" Then Exit For
   '¡ô¦pªGi°j°é²Ä3ÄæBrr°}¦C­È¸g¹L¥hÀY§ÀªÅ¥Õ¦r¤¸«á¬O ªÅ¦r¤¸!´Nµ²§ôµ{§Ç°õ¦æ
   If InStr(Brr(i, 3), We) Then
   '¡ô¦pªGi°j°é²Ä3ÄæBrr°}¦C­È¸Ì¦³¥]§tWe³o¦r¦êÅܼÆ??
      If N = 0 Then
      '¡ô¦pªGN³oªø¾ã¼ÆÅܼƬOªì©l­È 0??
         Crr = Arr
         '¡ô¥OCrr¬O Arr³o­ÓªÅ°}¦C
         For j = 0 To UBound(T)
         '¡ô³]¶¶°j°é!¥Oj±q0¶]¨ì T°}¦Cªº³Ì«á¤@­Ó¯Á¤Þ¸¹½X
            Crr(j) = Brr(1, T(j))
            '¡ô¥Oj°j°éCrr°}¦C­È¬O ²Ä1¦C²Ä(j°j°é¼Æ«ü¦VT°}¦C­È)Ä檺Brr°}¦C­È
         Next
         N = N + 1
         '¡ô¥ONÅܼƲ֥[ 1
         Y(N) = Crr
         '¡ô¥O¥HNÅܼƬ°key,item¬OCrr°}¦C,­Ë¤JY¦r¨å¤¤
      End If
      N = N + 1
      '¡ô¥ONÅܼƲ֥[ 1
      Crr = Arr
      '¡ô¥OCrr¬O Arr³o­ÓªÅ°}¦C
      For j = 0 To UBound(T)
      '¡ô³]¶¶°j°é!¥Oj±q0¶]¨ì T°}¦Cªº³Ì«á¤@­Ó¯Á¤Þ¸¹½X
         Crr(j) = Brr(i, T(j))
         '¡ô¥Oj°j°éCrr°}¦C­È¬O ²Äi°j°é¦C²Ä(j°j°é¼Æ«ü¦VT°}¦C­È)Ä檺Brr°}¦C­È
      Next
      Y(N) = Crr
      '¡ô¥O¥HNÅܼƬ°key,item¬OCrr°}¦C,­Ë¤JY¦r¨å¤¤
   End If
Next
If N = 0 Then Exit Sub
'¡ô¦pªGNÅܼƬO 0,´Nµ²§ôµ{§Ç°õ¦æ
Workbooks.Add
'¡ô¥Oµ{§Ç²£¥Í¤@­Ó·s¬¡­¶Ã¯
[A2].Resize(N, UBound(Arr) + 1) = Application.Transpose(Application.Transpose(Y.ITEMS))
'¡ô¥O³o·s¬¡­¶Ã¯±q[A2]ÂX®iÁa¦VNÅܼƦC,¾î¦VArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ+1Äæ,³o½d³òÀx¦s®æªº­È,
'¥HY¦r¨åªºitem Âà¸m¨â¦¸,­Ë¤J³oÂX®iªº½d³òÀx¦s®æ¤¤

Range([A1], ActiveSheet.UsedRange).Borders.LineStyle = 1
'¡ô¥O¦³¨Ï¥ÎªºÀx¦s®æ®æ½u¬O ²Ó¹ê½u
Cells.Columns.AutoFit
'¡ô¥O©Ò¦³Àx¦s®æÄæ¼e¦Û°Ê½Õ¾ã
[2:2].Font.Bold = True
'¡ô¥O²Ä2¦Cªº¦rÅé¬O²ÊÅé
[A1].NumberFormatLocal = "m""¤ë""d""¤é"";@"
'¡ô¥O[A1]ªº®æ¦¡¬O?¤ë?¤é
[A1] = Da: [B1] = We
'¡ô¥O[A1]­È¬O DaÅÜ:[B1]­È¬O WeÅܼÆ
Set Y = Nothing
Set Brr = Nothing
Erase Crr, Arr
'¡ôÄÀ©ñÅܼÆ
End Sub

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

TOP

¦^´_  Andy2483


    ½Æ²ß¤F¤@¤U,¤ß±oµù¸Ñ,½Ð«e½ú­Ì«ü¾É
Option Explicit
Sub ²Å¦X¦h±ø¥ó±a¥X¬ÛÃö¸ê ...
Andy2483 µoªí©ó 2022-12-23 16:47



    ÁÂÁ«ü±Ð¡A¨ü¯q¤F¡C

TOP

¦^´_  013160


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨ÒÀÉ®×
«á¾ÇÂǦ¹¥DÃD¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¦ý¤£ª¾¬O§_²Å¦X«e½ú±¡ ...
Andy2483 µoªí©ó 2022-12-21 15:21



   ¸ò§Ú·Q­nªº¦³ÂI®t¶Z¡A¦ý¦³¤C¤K¦¨²Å¦X¡AÁÂÁ«ü±Ð!!

TOP

B13//
=RIGHT(TEXT(A13,"aaa"))  A13¿é¤J¤é´Á, ¦Û°ÊÅÜ´«¬P´Á

A15//°}¦C¤½¦¡(¤TÁä¦P«ö)
=iferror(INDE ...
­ã´£³¡ªL µoªí©ó 2022-12-21 19:28



    ·PÁ±zªº«üÂI¡C

TOP

google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

        ÀR«ä¦Û¦b : Ä@­n¤j¡B§Ó­n°í¡B®ð­n¬X¡B¤ß­n²Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD