全体を表示 マクロ 色が思うように、表示できない
「マクロ 色が思うように、表示できない」で質問したことへの追加になります。「S1299792さん」から、全体を表示しないと回答がしずらいことの指摘がありました。すみませんでした。その通りだと思いましたので、再度質問させて頂きました。 また、「watabe007さん」からの回答からコピー貼り付けの部分を教えて頂いたものも使って、改めてコードを書き換えて示します。
現在コピー貼り付け・ソート・J;列以外はコード通りに出来上がっています。それにJ列の欠・合も指示通りにできています。不だけがピンク色になりません。
なお、なぜか一カ所だけピンクになっているところがあります。条件の「条件 合計」・「条件 不合格」最初のEの不のところの条件だけは、ピンクになっています。
下記のが全体のコードです。
Sub 条件つきソート色つけ()
Dim LastRow As Long, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1:J" & LastRow).Copy Sheets("sheet2").Range("A1")
End With
Application.CutCopyMode = False
Sheets("Sheet2").Select
Range("A1:J" & LastRow).Sort Key1:=Range("H1"), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
Range("E2:J" & LastRow).Interior.ColorIndex = 0
'文言の詳細について
'部品名と詳細---------------------------------------略称
'ghyu--------------------------------------←E列
'klub---------------------------------------←F列
'llpo----------------------------------------←G列
'合計個数(合計)-------------------------←H列 合計
'数量順位---------------------------------←I列 順位
'合格・不合格(合・不)欠品(欠)-----←J列 合・不・欠
For i = 2 To LastRow
If Cells(i, "E").Value = "" Then
Cells(i, "E").Resize(, 6).Value = "欠" 'E列
ElseIf Application.CountIf(Cells(i, "E").Resize(, 6), "欠") > 0 Then
Cells(i, "J").Value = "欠"
ElseIf Cells(i, "H") >= 1 And Cells(i, "H") <= 49 Then '条件 合計
Cells(i, "J") = "不"
ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") >= 6) And Cells(i, "G") >= 10 Then '条件 これ以上は合格
Cells(i, "J") = "合"
ElseIf (Cells(i, "E") = 0 Or Cells(i, "F") = 0) Or Cells(i, "G") = 0 Then '条件 全て０で不合格
Cells(i, "J") = "不"
ElseIf (Cells(i, "E") <= 19) Then '条件 不合格
Cells(i, "J") = "不"
ElseIf (Cells(i, "F") <= 5) Then '条件 不合格
Cells(i, "J") = "不"
ElseIf (Cells(i, "F") <= 10) Then '条件 不合格
Cells(i, "J") = "不"
ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") >= 6) And Cells(i, "G") <= 9 Then '条件 E=○ F=○ G=× 不合格
Cells(i, "J") = "不"
ElseIf (Cells(i, "E") >= 20 And Cells(i, "F") <= 5) And Cells(i, "G") <= 9 Then '条件 E=○ F=× G=× 不合格
Cells(i, "J") = "不"
ElseIf (Cells(i, "E") <= 19 And Cells(i, "F") >= 6) And Cells(i, "G") <= 9 Then '条件 E=× F=○ G=× 不合格
Cells(i, "J") = "不"
ElseIf (Cells(i, "E") <= 19 And Cells(i, "F") <= 5) And Cells(i, "G") >= 10 Then '条件 E=× F=× G=○ 不合格
Cells(i, "J") = "不"
End If
If Cells(i, "E") >= 1 And Cells(i, "E") < 20 Then
Cells(i, "E").Interior.ColorIndex = 6 ' 6は 黄色
End If
If Cells(i, "F") >= 1 And Cells(i, "F") < 6 Then
Cells(i, "F").Interior.ColorIndex = 6 ' 6は 黄色
End If
If Cells(i, "F") >= 6 And Cells(i, "F") < 10 Then
Cells(i, "F").Interior.ColorIndex = 34 '34は 淡い青色
End If
If Cells(i, "G") >= 1 And Cells(i, "G") < 10 Then
Cells(i, "G").Interior.ColorIndex = 6 ' 6は 黄色
End If
If Cells(i, "H") >= 1 And Cells(i, "H") <= 49 Then
Cells(i, "H").Interior.ColorIndex = 4 ' 4は うぐいす色
End If
If Cells(i, "J") >= "不" Then
Cells(i, "J").Interior.ColorIndex = 38 '38は ローズ
If Cells(i, "J") >= "合" Then
Cells(i, "J").Interior.ColorIndex = 2 ' 2は 白色
ElseIf Cells(i, "J") = "欠" Then
Cells(i, "J").Interior.ColorIndex = 45 '45は 薄いオレンジ色
End If
For j = 5 To 9 'D-F
If Cells(i, j).Value = 0 Then
Cells(i, j).Interior.ColorIndex = 3 '3は 赤色
ElseIf Cells(i, j).Value = "欠" Then
Cells(i, j).Interior.ColorIndex = 45 '45は 薄いオレンジ色
End If
Next j
For k = 5 To 9 'G-I
If Cells(i, j).Value = "欠" Then
Cells(i, j).Interior.ColorIndex = 45 '45は 薄いオレンジ色
End If
Next k
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
お礼
質問No.9584369 https://okwave.jp/qa/q9584369.html すみませんでした、要領が悪くて。なるほどですね、ルール常識ですね。今後ともお教え頂ければ幸いです。回答して頂く方にその辺りまでするべきでした。もう訳ありません。