みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

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

解決済みの質問

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

 下記のようなコードで部品の管理をしています。条件が多くて少し複雑になっています。
とりあえずは、うまくできました。J列の結果だけが、うまくできません。
但し、J列の結果が(38はローズ )の表示がうまくいきません。(6の黄色)になってしまいます。
要するに、J列の結果が不がローズ色で、合が白色で、欠が薄いオレンジ色になればよいということなのです。
原因が分からず困ってしまって、お聞きする次第です。回答して頂けるものでしようか。
ご教授下されば幸いに存じます。よろしくお願いします。 

Macro2 Macro
マクロ記録日 :
'
Sheets("sheet1").Select
Columns("A:J").Select
Selection.Copy

Sheets("sheet2").Select
Columns("A:J").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal

Dim i As Long, LastRow As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Range("J2:J" & LastRow).ClearContents '← E2:Jにすると、欠に全部なります、この設定もおかしいように思いますが?
Range("E2:J" & LastRow).Interior.ColorIndex = 0

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'文言の詳細について
'部品名と詳細-------------------------------------略称           
'ghyu--------------------------------------←E列  
'klub---------------------------------------←F列 
'llpo----------------------------------------←G列 
'合計個数(合計)-------------------------←H列  合計  
'数量順位---------------------------------←I列   順位
'合格・不合格(合・不)欠品(欠)-----←J列  合・不・欠

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は ローズ   
End If
If Cells(i, "J") >= "合" Then
Cells(i, "J").Interior.ColorIndex = 2 ' 2は  白色 
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-03 22:54:48

QNo.9584369

困ってます

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

https://okwave.jp/qa/q9580927.html
こちらは未解決ですか?

投稿日時 - 2019-02-04 09:13:33

お礼

解決しました。お礼をして終わりだと思っていました。ベストアンサーを忘れていました。すみません。

投稿日時 - 2019-02-04 21:18:37

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

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

回答(3)

ANo.2

参考に
Sub Test()
  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
  For i = 2 To LastRow
    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は  黄色
    ElseIf 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は ローズ
    ElseIf 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
  Next i
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

投稿日時 - 2019-02-04 09:00:22

お礼

コピペとソートはうまくできました。しかし、列の色はうまくできません。
SI299792さんが言われる通りに全体を提示したいと思います。すみません。面倒をおかけします。有難うございます。

投稿日時 - 2019-02-04 21:26:44

ANo.1

これ、動いているものをそのままコピペしましたか?

For i = が抜けているので、このままではコンパイルエラーです。
また、Sub Macro2()もぬけているし、Macro2 Macroもコメントになっていない。
ということは、一部分の抜粋でしょう。そこで色を黄色にしているのではないですか。でなければ説明できません。
不要な所を削除するのはいいですが、せめて動く状態で載せて下さい。

その上でおかしな所ですが、
Range("J2:J" & LastRow).ClearContents
なぜ消すのですが。J 列は全て空白になります。従って色は付きません。色を付けて文字は消したいということでしょうか。であればプログラムの最後に文字を消すが、sheet1を参照するかです。

If Cells(i, "J") >= "不" Then
何故ですが。
If Cells(i, "J") = "不" Then
ではないですか。

投稿日時 - 2019-02-04 04:34:50

お礼

SI299792さんが言われる通りに全体を提示したいと思います。すみません。再度質問したいと思います。有難うございます。

投稿日時 - 2019-02-04 21:28:02

あなたにオススメの質問