| |
今一状況が把握できませんが？
試しに、こんなのでは？
シート2C列のセルのColorIndexを使いますので
シート2C列は、C列の文字に対応するBackColorにして置いて下さい
シート1のシートモジュールは以下のコードを記入します
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim vntFound As Variant
Dim vntValue As Variant
Dim rngList As Range
With Target
If .Count <> 1 Then Exit Sub
If Not (.Column = 3 Or .Column = 6 Or .Column = 9) Then Exit Sub
vntValue = .Value
End With
With Worksheets("Sheet2")
Set rngList = .Range(.Cells(2, "C"), .Cells(Rows.Count, "C").End(xlUp))
vntFound = Application.Match(vntValue, rngList, 0)
If Not IsError(vntFound) Then
Target.Interior.ColorIndex _
= rngList.Item(vntFound, 1).Interior.ColorIndex
Else
Target.Interior.ColorIndex = xlNone
End If
End With
Set rngList = Nothing
End Sub
シート2のシートモジュールには以下を記述します
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim j As Long
Dim lngRows As Long
Dim vntFound As Variant
Dim rngList As Range
With Target
If .Count > 1 Then
Exit Sub
End If
If .Column <> 3 Then
Exit Sub
End If
If IsEmpty(.Value) Then
Exit Sub
End If
End With
With Me
Set rngList = .Range(.Cells(2, "C"), .Cells(Rows.Count, "C").End(xlUp))
End With
With Worksheets("Sheet1")
lngRows = .UsedRange.Rows.Count
For i = 3 To 9 Step 3
For j = 2 To lngRows
vntFound = Application.Match(.Cells(j, i).Value, rngList, 0)
If Not IsError(vntFound) Then
.Cells(j, i).Interior.ColorIndex _
= rngList.Item(vntFound, 1).Interior.ColorIndex
Else
.Cells(j, i).Interior.ColorIndex = xlNone
End If
Next j
Next i
End With
Set rngList = Nothing
End Sub
シート2のC列の値（色名）が変更に成ると
シート1のC、F、I列の色を変更します、因って非常に時間が掛かるかも解りません？
|
|
Hirofumi
- 10/12/13(月) 15:48 -
