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

[µo°Ý] Ãö©óÄæ¦ì¦rÅéÃC¦â®t²§ªº§PÂ_?

[µo°Ý] Ãö©óÄæ¦ì¦rÅéÃC¦â®t²§ªº§PÂ_?

Hello, ¦U¦ì¤j¤j

   ©êºp, ¤½¥qµLªk¤W¶Çªþ¥ó»P¹Ï¤ù!!
   ¦p¤Uµ{¦¡¬q©Ò¥Ü, §Ú¦³¤G­ÓÄæ¦ì, »Ý­n§P§O¨ä¤º®e¦rÅ馳µLÅܧóÃC¦â, ¦ý¨C¤@­Ó¦r³£¥h§PÂ_ªº¸Ü, ·|«Ü®e©ö³y¦¨¨t²Î°õ¦æªº®É¶¡Åܪø.
   ¦ý~¥ç¦pµ{¦¡¬q¤¤ªºµù¸Ñ, ±N¨äEnable ªº¸Ü, «o¥u¯à§PÂ_¾ã­ÓÄæ¦ìªº¦rÅéÃC¦â,
   ©Ò¥H¤£ª¾¦³¦ó¤è¦¡¥i¥H¥ý¦æ°µÄæ¦ì¹ïÄæ¦ìªºÃC¦â§P§O, ¦A¶i¦Ó¹ïÃC¦â¦³²§ªºÄæ¦ì, ¦A¶i¦æ¦r»P¦rªº½T»{?

Thanks ~




Sub FntColorChk()

    Dim r As Integer, i As Integer, j As Integer
    Dim f As Boolean
    Dim d1 As Date, d2 As Date


    r = ActiveSheet.Cells(65536, 2).End(xlUp).Row
    Range("E2:H1000").ClearContents
    d1 = Now()
   
    Application.ScreenUpdating = False
   
    For i = 2 To r Step 1
        f = True
        d2 = Now()
        DoEvents
''        If Cells(i, 2).Font.Color <> Cells(i, 3).Font.Color Or _
''           Cells(i, 2).Font.ColorIndex <> Cells(i, 3).Font.ColorIndex Then

           For j = 1 To Len(Cells(i, 2).Value) Step 1
               If Cells(i, 2).Characters(Start:=j, Length:=1).Font.ColorIndex <> Cells(i, 3).Characters(Start:=j, Length:=1).Font.ColorIndex Then
                  f = False
                  Exit For
               End If
           Next j
''        End If
        Cells(i, 6).Value = Format((Now() - d2) * 24 * 60 * 60, "0.000")
        If f = False Then
           Cells(i, 5).Value = "Change"
        End If
        Cells(i, 7).Value = DatePart("s", Now() - d1)
    Next i
   
    Application.ScreenUpdating = True
    MsgBox "Finish ..."
   
End Sub
·s¤â¤W¸ô¡A½Ð¦h¥]²[¡C

Hello, °a¤ªºµ¤j

ÁÂÁ±zªºÀ°¦£!!
¦]¬°§Úªº¸ê®Æ¬ù¦b1000¦æ¥ª¥k,
µo²{¥u­n¨t²Î¤@¶i¤J¨ìCharacter ªº¦r¤¸¤ñ¹ï®É,
´N·|³y¦¨°õ¦æ³t«×ªºÅܺC!!
¦Ó¥Bµo°Ýªº°ÝÃD¤]¬O·N¦bÁY´î¨t²Î°õ¦æ®É¶¡...
Anyway, ÁÙ¬OÁÂÁ±zªº¤j¤OÀ°¦£.
·s¤â¤W¸ô¡A½Ð¦h¥]²[¡C

TOP

¦^´_ 14# ¼B¤j­G

­è¤~µo²{ ÀɮרS¤W¶Ç¦n  ©êºp ¦A¶Ç¤@¦¸

0412.rar (20.54 KB)

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2021-4-12 21:29 ½s¿è

¦^´_ 14# ¼B¤j­G

©êºp ÀɮרS¦³¦s¨ìÀÉ >"< ...
¦³ªÅÀ°§Ú¸Õ¸Õ¬Ý ³o­Óµ²ªG¬O¤£¬O§A­nªº  
¦ý¦³¤@­Ó«Ü¤jªº°ÝÃD  ¦pªGÀɮ׫ܤj ·|¶]«D±`ºC..¦]¬°§Úªº°j°é¤Ó¦h¤F ¦Ó¥B¦êÁp¤Ó¦h¦¸..
¤£ª¾¹D¦pªG¥Î ª«¥ó¥[¦r¨å ·|¤£·|¤ñ¸û§Ö ©ÎµÛ ¦³§ó¦nªº¼gªk ¬Ý¬Ý¦³¨S¦³¤j¤j¥i¥HÀ°¦£  ·PÁÂ
  1. Public Sub §PÂ_ÃC¦â½m²ß0412()
  2. Application.ScreenUpdating = False
  3. Set xD = CreateObject("Scripting.Dictionary")

  4. For I = 1 To Cells(1, 1).End(4).Row
  5. E = Cells(I, 1)
  6.     xD(E) = Trim(xD(E) & " " & I) & E
  7. Next I
  8. E = ""

  9. For Each D In xD
  10.     SP = Split(xD(D), " ")
  11.     If UBound(SP) = 0 Then xD.Remove (D): GoTo A01
  12.     For Each S In SP
  13.         If UBound(SP) > 0 Then
  14.             If E <> "" Then xD(E) = Trim(xD(E) & " " & Mid(S, 1, 1))
  15.             E = ""
  16.         End If
  17.     Next S
  18. A01: Next D

  19. For Each D In xD
  20. SP = Split(xD(D), " ")
  21.     For Each S In SP
  22.         For Y = 1 To Len(Cells(Mid(S, 1, 1), 1))
  23.             E = E & Cells(Mid(S, 1, 1), 1).Characters(Y, 1).Font.ColorIndex
  24.         Next Y
  25.         If E <> "" Then xD(E) = Trim(xD(E) & " " & Mid(S, 1, 1))
  26.         If F = 0 Then xD.Remove (D): F = 1
  27.         E = ""
  28.     Next S
  29. Next D

  30. For Each D In xD
  31. SP = Split(xD(D), " ")
  32.     If UBound(SP) < 1 Then
  33.         G = G & "," & Cells(xD(D), 1).Row
  34.     End If
  35. Next D

  36. MsgBox Mid(G, 2) & "¦CÃC¦â¤£¬Û¦P"

  37. Application.ScreenUpdating = True
  38. End Sub
½Æ»s¥N½X
[attach]33190[/attach]

0412.rar (7.51 KB)

TOP

Hello, °a¤ªºµ¤j

©êºp! §Ú¥¼¦b±zªºªþ¥ó¸Ì, ¬Ý¨ì¥ô¦óªºµ{¦¡¬q. Thanks ~
·s¤â¤W¸ô¡A½Ð¦h¥]²[¡C

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2021-4-11 23:48 ½s¿è

¦^´_ 10# ¼B¤j­G

¦³ªÅÀ°§Ú¬Ý¬Ý³o¼Ë¬O¤£¬O§A­nªºµ²ªG  ÁÂÁÂ
0411.rar (6.3 KB)

TOP

Program example.


FntColorChk.rar (15.64 KB)
·s¤â¤W¸ô¡A½Ð¦h¥]²[¡C

TOP

Hello, °a¤ªºµ¤j

¦A¬Ý¬Ý¯à§_¤W¶Ç?
¦pªþ¥ó©Ò¥Ü, ¤G­Ócellªº¦rÅéÃC¦â¤ñ¸û,
¥i¦³¤°»ò«ü¥O¥i¥H¤£°µ¤@­Ó¦r¤@­Ó¦rªºÃC¦â¤ñ¹ï?
¦]¬°¤£ª¾¬°»ò¤°»ò, ¦pªG°µ¤@­Ó¦r¤@­Ó¦rªº¤ñ¹ï,
«Ü®e©ö³y¦¨¤U¤@­Órowªº¨t²Î°õ¦æ®É¶¡ÅܺC!!

FntColorChk.rar (15.64 KB)
·s¤â¤W¸ô¡A½Ð¦h¥]²[¡C

TOP

Hello, °a¤ªºµ¤j

ÁÂÁ±zªºÀ°¦£.
¦ý³o­Ó¤è¦¡¤]¥u¬O°O¿ý¤@­Ócell¸Ìªº¦rÅé¦ó¦ì¸mªºÃC¦â¦³²§¦Ó¤w,
§Ú­nªº¥u¤G­Ócell¸Ì, ¬Û¦Pªº¦r¼Æ, ¦ý¬Y¨Ç¦ì¸mªº¦rÅéÃC¦â, ¤G­Ócell¬O¦³Åܲ§ªº.
¦³¤°»ò¤è¦¡¥i¥H¤£»Ý­n¤@­Ó¤@­Ó¦r¥h, ¤G­Ócellªº¤ñ¹ï?
¦Ó¬O¥i¥H¥ý°µ¤G­ÓcellªºÃC¦â¬O§_¤@­P? ¦b¤£¤@­P®É, ¤~¶i¦æ¦rÀW¦ì¸mªº´M§ä,
¦]¬°¥u­n¤@¶i¤J¨ìCharactersªº¤ñ¹ï, «Ü®e©ö³y¦¨¨t²Î°õ¦æÅܺC.
Thanks ~

ps. ¹Ï¤ù­n«ç»òªþ¥[?  ¦]¬°¨C¦¸¤W¶Ç§¹¹Ï¤ù, «ö½T»{¤§«á, ºô­¶´NÅܱo¤@¤ùªÅ¥Õ¤F!
«áÄò¦A¬Ý, ´N¥u³Ñ¤@¦êªþ¥ó¥N½X!!
·s¤â¤W¸ô¡A½Ð¦h¥]²[¡C

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2021-4-10 23:06 ½s¿è

¦^´_ 8# ¼B¤j­G
¦³ªÅÀ°§Ú¸Õ¸Õ¬Ý ³o¼Ë¦æ¤£¦æ ·PÁÂ
  1. Public Sub §PÂ_ÃC¦â½m²ß()

  2. Set xD = CreateObject("Scripting.Dictionary")

  3. For I = 1 To 4
  4.     For Y = 1 To Len(Cells(I, 1))
  5.         E = E & Cells(I, 1).Characters(Y, 1).Font.ColorIndex
  6.     Next Y
  7.     xD(E) = Trim(xD(E) & " " & I)
  8.     E = ""
  9. Next I

  10. For Each D In xD
  11.     SP = Split(xD(D), " ")
  12.     If UBound(SP) < 1 Then
  13.         Cells(xD(D), 1).Select
  14.     End If
  15. Next D

  16. End Sub
½Æ»s¥N½X
0410.rar (6.31 KB)

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