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

[µo°Ý] ±Æ¯Zªí³sÄò7¤Ñ®É¥X²{´£¿ô

[µo°Ý] ±Æ¯Zªí³sÄò7¤Ñ®É¥X²{´£¿ô

Dear all,
§Ú¨Ì¾ÚYouTube¤W±Ð¾Ç¡A¤w¦b Excel ³]©wÀx¦s®æ®æ¦¡¤½¦¡¡A¬O¥i¥H³sÄò¤C¤é®É·|Àx¦s®æ·|ÅÜ©³¦â´£¿ô¡C
·Q°Ý¤@¤U¡A¬O§_¥i¥H±N»yªk¼g¦bVBA¤º¡A¦]¬°©È¦³¤H¤£À´Excel¶Ã«ö¨ì¡A¾É­PÀx¦s®æ¤½¦¡¶]¨ì¡C
½d³ò¬°¡GC11~AB41

±Æ¯Zªí-³sÄò7¤Ñ¥X²{´£¿ô.rar (13.44 KB)







ÁÂÁ¤j®a¡I¡I
Just do it.

¦^´_ 1# jsc0518


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾Ç¾Ç²ß«á«Øij¥H¤U¤è®×,½Ð¸Õ¸Õ¬Ý

Option Explicit
Sub ÀË´ú_¿ï¨ú°ÝÃD®æ()
Dim i&, Arr, n, xR As Range, C%, R&
Arr = ActiveSheet.UsedRange
For C = 1 To UBound(Arr, 2)
   For R = 1 To UBound(Arr)
      If InStr("/¥D/°Æ/¡´/", "/" & Trim(Arr(R, C)) & "/") Then
         n = n + 1
         If n >= 7 Then
            If Not xR Is Nothing Then
               Set xR = Union(xR, Cells(R, C))
               Else
                  Set xR = Cells(R, C)
            End If
         End If
         Else
            n = 0
      End If
   Next
   n = 0
Next
If Not xR Is Nothing Then
   Application.Goto xR
   Else
     MsgBox "¨S¦³³sÄò¤C¤Ñ¤W¯Z!"
End If
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 2# Andy2483

Dear Andy,

±z¦n¡I·PÁ±z¼ö¤ß¦a¦^ÂСB¸Ñ´b¡I
·Q»P±z½Ð±Ð¡G­Y­n­×§ï½d³ò C11~AB41  --> ¦b­þ¤@VBA»yªk­×§ï©O¡H

·P®¦¡I¡I
Just do it.

TOP

¦^´_ 3# jsc0518


    ÁÂÁ«e½ú¦^´_

­Y­n­×§ï½d³ò C11~AB41  --> ¦b­þ¤@VBA»yªk­×§ï©O¡H
Ans:¤£¥²­×§ïVBA»yªk!¦]¬°µ{¦¡§PÂ_¾ãªí³sÄò7¤Ñ(§t)¥H¤W¤W¯Z,²Ä7¤Ñ«áªºÀx¦s®æ³£·|³Q¿ï¨ú,¦pªG¨S¦³«hÅã¥Ü "¨S¦³³sÄò¤C¤Ñ¤W¯Z!"´£µøµ¡
PS: Arr = ActiveSheet.UsedRange   '¦³¨Ï¥ÎªºÀx¦s®æ

«Øij¥H­ì®æ¦¡¤Æ±ø¥ó¬°¥D,¦¹ÀË´ú¤è®×§@¬°»²§U
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 4# Andy2483
Dear Andy,

ÁÂÁ±zªº¼ö¤ß«ü¾É¡Aª¾¹D·N«ä¤F¡I·P®¦¡I
Just do it.

TOP

¦^´_ 1# jsc0518


    ÁÂÁ«e½ú
«á¾Ç¥t¤@­Ó¤è®×:§R°£¥þ³¡®æ¦¡¤Æ±ø¥ó,¥HIJµoÀˬd,²Ó¸`¦p¤U,½Ð¸Õ¸Õ¬Ý
1.¤U¤è½s¿è°Ï:·Æ¹«¥ªÁä§Ö«ö2¦¸¥i°µ ¡´ ¤Á´«
2.¤U¤è½s¿è°Ï:·Æ¹««ö¥kÁä¥i°µ "¥D" or  "°Æ"  ¤Á´«
3.¬õ¦â¦r&´£¥Üµ¡:³sÄò¤W¯Z7¤Ñ

±Æ¯Zªí-³sÄò7¤Ñ¥X²{´£¿ô_20230208.zip (25.84 KB)

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

TOP

¦^´_ 6# Andy2483
Dear Andy,

§Ú¦b½s¿è°Ï°ì C11~AB41¡A«ö¤U·Æ¹«¥kÁä­n°µ½Æ»s/¶K¤W°Ê§@®É¡A·|¥X²{µøµ¡³sÄò¤C¤Ñ¤W¯Z¡C
³o³¡¤À¥i¥H­×­q¶Ü¡H
Just do it.

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-2-9 07:24 ½s¿è

¦^´_ 7# jsc0518


    ÁÂÁ«e½ú¦A¦^´_
1.«á¾ÇÀu¥ý¦Ò¼{ªº¬O:¦³¿ù»~(³sÄò7¤Ñ¤W¯Z)­n°¨¤W§ïµ½,©Ò¥H[K16]¥H¥ªÁä§Ö«ö2¤U,´N¥i¥H¤£¦A¥X²{´£¥Ü
2.½s¿è°Ï¤º¥u­n¬O ¡´/¥D/°Æ ¥ô¤@ºØ,¥ªÁä§Ö«ö2¤U,³£·|ÅܪťÕ
3. ½s¿è°Ï¤º¥u­n¬O ¡´/°Æ ©ÎªÅ¥Õ ¥ô¤@ºØ,«ö¥kÁä·|ÅÜ "¥D"
4. ½s¿è°Ï¤º¥u­n¬O "¥D" ,«ö¥kÁä·|ÅÜ "°Æ"
5.¦pªG±`¥Î ¥kÁä ½Æ»s/¶K¤W,«Øij¥ÎCtrl+C  /  Ctrl+V ¨ú¥N³o¨â¥\¯à

[K16]¥H¥ªÁä§Ö«ö2¤Uªºµ²ªG:
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 8# Andy2483
Dear Andy,
§Úª¾¹D§A³]­pªº·N«ä¤F¡A§Ú´ú¸Õ¬Ý¬Ý¡IÁÂÁ§A¼Ú¡I
Just do it.

TOP

¦^´_ 9# jsc0518


    ÁÂÁ«e½ú¦^´_
¤µ¤Ñ½Æ²ß¦AÀˬd¤F¤@¤U¨Ã§@µù¸Ñ,½Ð«e½ú°Ñ¦Ò

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
'¡ô¥H¤U¬OÃö©ó¥ªÁäÂùÀ»ªºµ{§Ç
   If .Count > 1 Then Exit Sub
   '¡ô¦pªGIJµoªºÀx¦s®æ¼Æ¤j©ó1,´Nµ²§ôµ{¦¡°õ¦æ (¨Ò¦p:IJµoªº¬O¦X¨ÖÀx¦s®æ)
   If InStr("/¥D/°Æ/¡´//", "/" & Trim(.Value) & "/") Then
   '¡ô¦pªGIJµo®æ­È¥h°£«e«áªÅ¥Õ¦r¤¸«á,¦b«e«á³s±µ "/" ²Å¸¹ªº·s¦r¦ê,¥]§t¦b "/¥D/°Æ/¡´//"¦r¦ê¸Ì??
      .Font.ColorIndex = 1
      '¡ô¥OIJµo®æ¦r¦â¬O ¶Â¦â
      .Value = Switch(.Value = "", "¡´", .Value = "¡´", "", .Value = "¥D", "", .Value = "°Æ", "")
      '¡ô¥OIJµo®æ­È¬O¥HSwitch ¨ç¦¡¦^¶Çªº¦r¦ê­È
      'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/switch-function
      '¦pªG­ìÀx¦s®æ­È¬O ªÅ¦r¤¸,´N¦^¶Ç "¡´"
      '¦pªG­ìÀx¦s®æ­È¬O "¡´",´N¦^¶Ç ªÅ¦r¤¸
      '¦pªG­ìÀx¦s®æ­È¬O "¥D",´N¦^¶Ç ªÅ¦r¤¸
      '¦pªG­ìÀx¦s®æ­È¬O "°Æ",´N¦^¶Ç ªÅ¦r¤¸

      Cancel = True
      '¡ô¨ú®ø¥ªÁäÂùÀ»ªº­ì¥\¯à
   End If
End With
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target
'¡ô¥H¤U¬OÃö©ó¥kÁä³æÀ»ªºµ{§Ç
   If .Count > 1 Then .Font.ColorIndex = 1: Call ÀË´ú_¿ï¨ú°ÝÃD®æ: Exit Sub
   '¡ô¦pªGIJµoªºÀx¦s®æ¼Æ¤j©ó1,¥OIJµo®æ¦r¦â¬O ¶Â¦â,°õ¦æ (ÀË´ú_¿ï¨ú°ÝÃD®æ)°Æµ{¦¡,µ²§ôµ{¦¡°õ¦æ
   If InStr("/¥D/°Æ/¡´//", "/" & Trim(.Value) & "/") Then
   '¡ô¦pªGIJµo®æ­È¥h°£«e«áªÅ¥Õ¦r¤¸«á,¦b«e«á³s±µ "/" ²Å¸¹ªº·s¦r¦ê,¥]§t¦b "/¥D/°Æ/¡´//"¦r¦ê¸Ì??
      .Value = Switch(.Value = "", "¥D", .Value = "¡´", "¥D", .Value = "¥D", "°Æ", .Value = "°Æ", "¥D")
      '¡ô¥OIJµo®æ­È¬O¥HSwitch ¨ç¦¡¦^¶Çªº¦r¦ê­È
      '¦pªG­ìÀx¦s®æ­È¬O ªÅ¦r¤¸,´N¦^¶Ç "¥D"
      '¦pªG­ìÀx¦s®æ­È¬O "¡´",´N¦^¶Ç "¥D"
      '¦pªG­ìÀx¦s®æ­È¬O "¥D",´N¦^¶Ç "°Æ"
      '¦pªG­ìÀx¦s®æ­È¬O "°Æ",´N¦^¶Ç "¥D"

      Cancel = True
      '¡ô¨ú®ø¥kÁä³æÀ»ªº­ì¥\¯à
   End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
'¡ô¥H¤U¬OÃö©óÀx¦s®æ¤º®e½s¿èIJµoªºµ{§Ç
   Call ÀË´ú_¿ï¨ú°ÝÃD®æ
   '¡ô°õ¦æ (ÀË´ú_¿ï¨ú°ÝÃD®æ)°Æµ{¦¡
   
End With
End Sub

Option Explicit
Sub ÀË´ú_¿ï¨ú°ÝÃD®æ()
Dim Arr, xR As Range, C%, i&, R&, n&
'¡ô«Å§iÅܼÆ! (Arr)¬O³q¥Î«¬ÅܼÆ,(xR)¬OÀx¦s®æÅܼÆ,(C)¬Oµu¾ã¼ÆÅܼÆ,(i,R,n)¬Oªø¾ã¼ÆÅܼÆ
Arr = ActiveSheet.UsedRange
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥H²{ªí¦³¨Ï¥ÎÀx¦s®æÂX®i³Ì¤p¤è¥¿½d³òÀx¦s®æ­È­Ë¤J
For C = 1 To UBound(Arr, 2)
'¡ô³]¶¶°j°é!C±q1¨ìArr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹¼Æ
   For R = 1 To UBound(Arr)
   '¡ô³]¶¶°j°é!R±q1¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ
      If InStr("/¥D/°Æ/¡´/", "/" & Trim(Arr(R, C)) & "/") Then
      '¡ô¦pªG°j°éArr°}¦C­È¥h°£«e«áªÅ¥Õ¦r¤¸«á,¦b«e«á³s±µ "/" ²Å¸¹ªº·s¦r¦ê,¥]§t¦b ""/¥D/°Æ/¡´/""¦r¦ê¸Ì??
         If Cells(R, C).Font.ColorIndex <> 1 Then Cells(R, C).Font.ColorIndex = 1
         '¡ô¦pªG°j°éÀx¦s®æ¦r¦â¤£¬O¶Â¦â!´NÅܬ° ¶Â¦â
         n = n + 1
         '¡ô¥On³oªø¾ã¼ÆÅܼƲ֥[ 1
         If n >= 7 Then
         '¡ô¦pªGnÅÜ¼Æ > 7 ??
            If Not xR Is Nothing Then
            '¡ô¦pªGxR³oÀx¦s®æÅܼƤw¦³ª«¥ó
               Set xR = Union(xR, Cells(R, C))
               '¡ô¥OxRÅܼƱN °j°éÀx¦s®æ¯Ç¤J¦b xRÅܼƫ᭱,¦¨¬°·sªºÀx¦s®æ¶°
               Else
                  Set xR = Cells(R, C)
                  '¡ô§_«h¥OxR ¬O°j°éÀx¦s®æ
            End If
         End If
         Else
            n = 0
            '¡ô¥OnÅܼÆÂk¹s
      End If
   Next
   n = 0
   '¡ô¥OnÅܼÆÂk¹s(¦]¬°¸óÄ椣¦A²Ö¥[¤W¯Z¤Ñ¼Æ)
Next
If Not xR Is Nothing Then
'¡ô¦pªGxR³oÀx¦s®æÅܼƤw¦³ª«¥ó
   Application.Goto xR
   '¡ô¿ï¨úxRÅܼÆÀx¦s®æ
   xR.Font.ColorIndex = 3
   '¡ô¥OxRÅܼÆÀx¦s®æ¦r¦â¬O ¬õ¦â
   MsgBox "****  ³sÄò¤C¤Ñ¤W¯Z!  ****"
   '¡ô¸õ¥X´£¥Üµ¡
End If
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¡i®É¶¡¦¨´N¤@¤Á¡j®É¶¡¥i¥H³y´N¤H®æ¡A¥i¥H¦¨´N¨Æ·~¡A¤]¥i¥HÀx¿n¥\¼w¡C
ªð¦^¦Cªí ¤W¤@¥DÃD