やりたいことは
シートA列に「前倒し」「調整」「後倒し」を入れる。
入力した行の”注文残数”が”不足数合計”を超えたとき
同じアイテムコードを含む行を黄色くする。
具体的には
アイテムコード「ミカン」の注番1を前倒し、注番2を調整とした時
それぞれの注文残数は”789”と”2000”で足すと”2700”で不足数合計”2668”を
超えます。そうすると、「ミカン」の行が黄色になります。
「メロン」は「前倒し」と記入した2つの注文残数が不足数合計を超えたので
注番6を記入しなくても「メロン」の行が黄色になります。
「リンゴ」は「前倒し」と記入していますが注文残数が不足数合計を超えていないので
行は着色されていません。
★コードを書いてみました。
Private Sub Worksheet_Change(ByVal Target As Range) Dim maxrow As Long, maxcol As Long Dim myrow As Long, mycol As Long Dim col1 As Long, col2 As Long, col3 As Long Dim i As Long, j As Long '最終行番 With Range("A1").SpecialCells(xlLastCell) maxrow = .Row End With '最終列番 maxcol = Cells(2, Columns.Count).End(xlToLeft).Column '「注文残数」列番 Dim zansu As Range Set zansu = Rows(2).Find(what:="注文残数", LookAt:=xlWhole) If zansu Is Nothing Then Exit Sub Else col1 = zansu.Column End If '「アイテムコード」列番 Dim item As Range Set item = Rows(2).Find(what:="アイテムコード", LookAt:=xlWhole) If item Is Nothing Then Exit Sub Else col2 = item.Column End If '「不足数合計」列番 Dim husoku As Range Set husoku = Rows(2).Find(what:="不足数合計", LookAt:=xlWhole) If husoku Is Nothing Then Exit Sub Else col3 = husoku.Column End If '選択したセルの行列番 myrow = Target.Row mycol = Target.Column 'A列に入力した時、最終列の隣の列に1と入力する。 If mycol = 1 Then If Target.Value <> "" Then Cells(myrow, maxcol + 1).Value = 1 ElseIf Target.Value = "" Then Cells(myrow, maxcol + 1).Value = "" End If 'A列に入力されている同一アイテムコードの注文残数合計 i = WorksheetFunction.SumIfs(Range(Cells(3, col1), Cells(maxrow, col1)), Range(Cells(3, col2), Cells(maxrow, col2)), Cells(myrow, col2).Value, Range(Cells(3, maxcol + 1), Cells(maxrow, maxcol + 1)), 1) '不足数合計 j = Cells(myrow, col3).Value If i > j Then With Range(Cells(myrow, 1), Cells(myrow, maxcol)).Interior If .ColorIndex = xlNone Then .Color = vbYellow Else .ColorIndex = xlNone End If End With End If End If End Sub
●教えてほしいことは
1.黄色に着色する箇所がアイテムコード全体とする方法が分かりません。
2.着色された行の「前倒し」などを消した時、不足数合計より注文残数が少なくなったら色を消す方法が分かりません。
3.1列目の複数のセルを選択して1回でDELETEすると
If Target.Value <> "" Thenでエラーになります。
回避できませんか
以上、3つについて教えて下さい。
あなたの回答
tips
プレビュー