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 |