For 循環

yunyan0805

各位大俠好，

小弟是VBA初學者，以下是我的問題點 ..


Sub TEST()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
On Error Resume Next
工作表1.Select
ir = Cells(65536, 2).End(xlUp).Row
For i = 2 To ir
d(Cells(i, 2).Value & "") = Range(Cells(i, 3), Cells(i, 3)).Interior.ColorIndex
Next
工作表8.Select
ir = Cells(65536, 2).End(xlUp).Row
For i = 4 To ir
Range(Cells(i, 2), Cells(i, 2)).Interior.ColorIndex = d(Cells(i, 1).Value & "")
Next



工作表1.Select
ir = Cells(65536, 2).End(xlUp).Row
For i = 2 To ir
d(Cells(i, 2).Value & "") = Range(Cells(i, 3), Cells(i, 3)).Interior.ColorIndex
Next
工作表8.Select
ir = Cells(65536, 14).End(xlUp).Row
For i = 4 To ir
Range(Cells(i, 14), Cells(i,14)).Interior.ColorIndex = d(Cells(i,13).Value & "")
Next
End Sub



工作表1.Select
ir = Cells(65536, 2).End(xlUp).Row
For i = 2 To ir
d(Cells(i,2).Value & "") = Range(Cells(i, 3), Cells(i, 3)).Interior.ColorIndex
Next
工作表8.Select
ir = Cells(65536,26).End(xlUp).Row
For i = 4 To ir
Range(Cells(i,26), Cells(i,26)).Interior.ColorIndex = d(Cells(i,25).Value & "")
Next
End Sub

這樣寫的話我要寫很多句，變數就是+12

我要怎麼寫　

thinkersky

Sub TEST()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
On Error Resume Next
工作表1.Select
ir = Cells(65536, 2).End(xlUp).Row
For i = 2 To ir
d(Cells(i, 2).Value & "") = Range(Cells(i, 3), Cells(i, 3)).Interior.ColorIndex
Next
工作表8.Select
for j=2 to 26 step 12  '26可以换成最后的列
ir = Cells(65536, j).End(xlUp).Row
For i = 4 To ir
Range(Cells(i, j), Cells(i, j)).Interior.ColorIndex = d(Cells(i, 1).Value & "")
Next
next
end sub