請問︰要如何修正? 謝謝!
Private Sub CommandButton1_Click()
Dim J%, K%, tx%, ty%, tz%, b
With Sheets(2)
Sheets(1).Range("J7", "P" & Sheets(2).[R6] + 5).Copy .[J7] tx = .[R7].End(xlDown).Row
ty = .[T5].End(xlToRight).Column
For tz = 20 To ty
.Range("T7:T" & tx).Select
For Each b In Selection
If b <> "" Then
For J = 10 To 16
For K = 10 To 16
If .Range("R" & b.Row) + 1 = .[T5] Then
If .Range("R" & b.Row) - .[T3] * 2 > 6 Then
If .Cells(.[T5] + 6, J) = .[R5] Then
If .Cells(.[T5] - 6, J) = .[R5] Then
If .Cells(.[T5] + 6, J) = .[R5] Then
With .Cells(.[T5] + 6, J): .Interior.ColorIndex = 4: .Font.ColorIndex = 3: .Font.FontStyle = "粗體": End With
With .Cells(.[T5] - .[T3] + 6, J): .Interior.ColorIndex = 45: .Font.ColorIndex = 3: .Font.FontStyle = "粗體": End With
With .Cells(.[T5] - .[T3] * 2 + 6, J): .Interior.ColorIndex = 8: .Font.ColorIndex = 3: .Font.FontStyle = "粗體": End With
End If
End If
End If
End If
End If
Next K
Next J
End If
Next b
Next tz
End With
[A1].Select
End Sub作者: 准提部林 時間: 2015-11-21 12:42
操作程式時, Sheets(2)不是當前工作表, 須先跳轉:
With Sheets(2) .Select
.Range("T7:T" & tx).Select 這行才不會錯誤
不過, 工作表跳轉若非必要, 可:
For Each b In .Range("T7:T" & tx) '不用Selection, 上兩行可刪去作者: Airman 時間: 2015-11-21 14:08
If .Cells(.[T5] + 6, J) = .[R5] Then
If .Cells(.[T5] - .[T3] + 6, J) = .[R5] Then
If .Cells(.[T5] - .[T3] * 2 + 6, J) = .[R5] Then
～～
～～
～～
End If
End If
End If
看不懂為何這樣寫，須三個if都成立，才進行之內的操作，
是否應各自分段：
If .Cells(.[T5] + 6, J) = .[R5] Then
～～
End If
If .Cells(.[T5] - .[T3] + 6, J) = .[R5] Then
～～
End If
If .Cells(.[T5] - .[T3] * 2 + 6, J) = .[R5] Then
～～
End If作者: Airman 時間: 2015-11-21 23:47
回復 6#准提部林
准大:
If .Cells(.[T5] + 6, J) = .[R5] Then
～～
End If
單獨條件即標示顏色是沒有問題。
回復 5#Airman
准大:
因您的提示~知道錯誤的程式碼在何處~
剛剛試將程式碼改為~
If .Cells(.[T5] + 6, I) = .[R5] Then
If .Cells(.[T5] - .[T3] + 6, J) = .[R5] Then
If .Cells(.[T5] - .[T3] * 2 + 6, K) = .[R5] Then
With .Cells(.[T5] + 6, I): .Interior.ColorIndex = 4: .Font.ColorIndex = 3: .Font.FontStyle = "粗體": End With
With .Cells(.[T5] - .[T3] + 6, J): .Interior.ColorIndex = 45: .Font.ColorIndex = 3: .Font.FontStyle = "粗體": End With
With .Cells(.[T5] - .[T3] * 2 + 6, K): .Interior.ColorIndex = 8: .Font.ColorIndex = 3: .Font.FontStyle = "粗體": End With
End If
End If
End If
即可完成顏色標示。
Private Sub CommandButton1_Click()
Dim b As Range, RW, y%
With Sheets(2)
Sheets(1).Range("J7", "P" & Sheets(2).[R6] + 5).Copy .[J7] Application.Goto .Range("T7:T" & .[R7].End(xlDown).Row) '不用Select，直接跳選目標區
RW = Array(.[T5], .[T5] - .[T3], .[T5] - .[T3] * 2) '３區的期數陣列
For Each b In Selection
If b <> "" Then
If .Range("R" & b.Row) + 1 = .[T5] And .Range("R" & b.Row) - .[T3] * 2 > 6 Then
Dim R(1 To 3) As Range, U%
For y = 1 To 3
Set R(y) = .[J:P].Rows(RW(y - 1) + 6).Find(.[R5], Lookat:=xlWhole) '標定３區[R5]值的儲存格
If R(y) Is Nothing Then U = 1: Exit For '若任一區不含 [R5]，以 U=1 表示，跳出
Next y
If U = 0 Then '３區皆含[R5]
For y = 1 To 3: R(y).Interior.ColorIndex = Array(4, 45, 8)(y - 1): Next '標示〔個別〕底色
With Union(R(1), R(2), R(3)).Font: .ColorIndex = 3: .FontStyle = "粗體": End With '設定文字
End If
End If
End If
Next b
.[A1].Select
End With
End Sub
If R(y) Is Nothing Then U = 1: Exit For
底下加一行：
If y > 1 Then If R(y).Column <> R(y-1).Column Then U = 1: Exit For '三區任一欄位不同作者: Airman 時間: 2015-11-23 19:01
回復 26#准提部林
准大:您好!
不好意思，恕小弟執著，還是希望您能賜教如11#的寫法~
因為11#的貴語法，同欄與不限同欄的區分~只要多加一列程式碼~
f y > 1 Then If R(y).Column <> R(y-1).Column Then U = 1: Exit For
非常簡捷便利。
RW = Array(b(1, -1), b(1, -1) - .[T3], b(1, -1) - .[T3] * 2)
For y = 1 To 3: Set R(y) = .[J:P].Rows(RW(y - 1) + 6).Cells: Next y
Dim M(1 To 3)
For k = 1 To 7
M(1) = k
For y = 2 To 3
M(y) = Application.Match(R(1)(k), R(y), 0)
If IsError(M(y)) Then M(1) = 0: Exit For 'If M(y) <> M(1) Then M(1) = 0: Exit For '若要求〔同欄〕，加入這行
Next y
If M(1) > 0 Then
For y = 1 To 3: R(y)(M(y)).Interior.ColorIndex = Array(4, 45, 8)(y - 1): Next
End If
Next k作者: Airman 時間: 2015-12-9 09:25
