|
▼bridgesbook さん 今晩は。
ごめんなさい。私のミスが入り込んでいるので、修正してください。
(1)A列を全て選択して消去しするとストレスを感じる動きになります。
(2)2列に渡って範囲指定して貼り付けると2列とも色が変化します。
の2点を解決するために、下記のように修正してください。
>Private Sub Worksheet_Change(ByVal Target As Range)
>
>Dim ra As Range
'============================================================ここから
Dim r As Range, 範囲 As Range
Set 範囲 = Application.Intersect(Target, Range("A1:A50"))
If 範囲 Is Nothing Then Exit Sub
For Each ra In 範囲
'============================================================ここまで
> If Application.CutCopyMode <> False Then Application.CutCopyMode = False
> ActiveSheet.Unprotect
> If ra.Value = "" Then
> ra.Interior.ColorIndex = xlNone '空欄なら無色
>' ra.BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic
> ra.Font.ColorIndex = 1
> Else
> ra.Interior.ColorIndex = ra.Value '着色
> ra.BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic
> Select Case ra.Value
> Case 2, 6, 19, 20, 24, 27, 34 To 40
> ra.Font.ColorIndex = 1
> Case Else
> ra.Font.ColorIndex = 2
> End Select
> End If
> ActiveSheet.Protect
> Next
>End Sub
|
|