こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

全体を表示 マクロ 色が思うように、表示できない

 「マクロ 色が思うように、表示できない」で質問したことへの追加になります。「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 '条件 全て0で不合格
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

投稿日時 - 2019-02-05 11:50:01

QNo.9584876

困ってます

質問者が選んだベストアンサー

【補足】目で見たら判る書き方を!

  Dim I AS Integer
  Dim isGokaku As Boolean
  Dim isKeppin As Boolean
  Dim intIE As Integer
  Dim intIF As Integer
  Dim intIG As Integer
  Dim intIH As Integer
  Dim intColor As Integer
  Dim strFlag As String

  ' ***********
  ' 判定準備
  ' ***********
  intIE = Cells(I, "E")
  intIF = Cells(I, "F")
  intIG = Cells(I, "G")
  intIH = Cells(I, "H")
  ' *******************
  ' 倫理式による判定
  ' *******************
  isKeppinn = intIH >= 1 And intIH <= 49
  isGoukaku = intIE >= 20 And intIF >= 6) * intIG >= 10 _
        + intIE= 0 + intIF= 0 + intIG = 0 _
        ‥‥
  ‥‥
  ' ***************
  ' 合欠不の表示
  ' ***************
  Cells(I,J) = Mid("合欠不", Abs(-1 + isKeppin * 1 + isGoukoaku * 2), 1)

  ' ************************
  ' ColorIndex の更新 E-H
  '
  ' 06:黄色
  ‥‥
  ‥‥
  '
  ' ************************
  Cells(i, "E").Interior.ColorIndex = _
          ((intIE >= 1 * intIE < 20)) * 6
  ‥‥
  ' ************************
  ' ColorIndex の更新 J
  '
  ' 38:ローズ
  ' 38:白
  ' 45:薄いオレンジ
  '
  ' ************************
  Cells(i, "J").Interior.ColorIndex = _
         Abs(isKeppin * 38 + isGoukoaku * 2 + Not isGoukaku * 45)

 これだと、プログラムコードを上から目で追うだけでチェックできます。

投稿日時 - 2019-02-05 17:33:08

お礼

有難うございます。こんな判定のことまで考えたことがありませんでした。腰を落ち着けて、しっかり考え直さないとできない気がしています。初心者であればあるほど、整理するべきなことが多くあると反省しています。

投稿日時 - 2019-02-05 18:27:12

ANo.3

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

【補足】論理式もあり

 正しいかどうかは置いといて、次のように論理式で書いたが良いのでは・・・

  Dim isGokaku As Boolean
  Dim isKeppin As Boolean

  isKeppinn = Cells(i, "H") >= 1 And Cells(i, "H") <= 49
   isGoukaku = (Cells(i, "E") >= 20 And Cells(i, "F") >= 6) _
        * Cells(i, "G") >= 10 _
        + Cells(i, "E") = 0 _
        + Cells(i, "F") = 0) _
        + Cells(i, "G") = 0

 これだと、論理式の順序次第では正誤チェックもたやすいと思う。

投稿日時 - 2019-02-05 14:28:17

お礼

有難うございます、少し勉強させて下さい。時間をかけてやってみます。

投稿日時 - 2019-02-05 18:20:50

ANo.1

 一度《Cells(i, "F") <= 10》の条件に合致しなのを除外しておいて《Cells(i, "G")》の値で再判定することは不能。また、 (Cells(i, "E") >= 20 の条件を書く必要はない。それに、《(Cells(i, "E") <= 19》という条件判定は既出、よって、最後の二つのIf 判定も成立しない。ともかく、If Then 文という手法を中止すべきと思う。

投稿日時 - 2019-02-05 14:14:00

お礼

ありがとうございます。もう少し、整理してみます。

投稿日時 - 2019-02-05 18:21:47

あなたにオススメの質問