ミスチルの大名曲の数々が配信決定!! 31日間無料!!【PR】

商品の品番やカテゴリー、売上などを記載した表が
A~O列まであります。

A列 品番
B列 納入先
C列 売上
O列 OK、もしくは空白

B列とC列は別しーとからvlookupで引き出し
それを値として張り付け直しているため
ところどころ#N/A が文字として入っています。

O列にOKと入っている時
B列が空白、もしくは#N/Aと入っている際に
[確認してください]とメッセージボックスを出すにはどうしたら良いでしょうか。
過去履歴を参照して以下のようにしましたが
上手く作動しません。
どうぞよろしくお願いします。


sub macro1()
 dim i as long
 dim mes as string
 dim lastrow as long

 range("B:C").interior.colorindex = xlnone
 lastrow = range("O65536").end(xlup).row

 for i= 1 to lastrow
  if cells(i, "O") = "OK" and cells(i, "B") = "" then
   mes = mes & vblf & "売上" & cells(i, "B") & "確認してください"
   cells(i, "B").interior.color = vbred
  end if
 next i
 msgbox mid(mes, 2)

 mes = ""
 for i = 1 to lastrow
  if cells(i, "O") = "OK" then
  if cells(i, "B") like "*N*" then
   mes = mse & vblf & "売上" & cells(i, "B") & "確認してください"
   cells(i, "B").interior.color = vbred
  end if
  end if
 next i
 msgbox mid(mes, 2)
end sub

A 回答 (2件)

どっちかというと、マクロとしては、別々にするか、まとめて一緒にしてしまったほうが良いような気がします。

空白を黄色、エラーを赤にしました。
参考にしてみてください。

''//
Sub Macro1()
 Dim i As Long
 Dim mes As String
 Dim LastRow As Long

 Range("B:C").Interior.ColorIndex = xlNone
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
 
 For i = 1 To LastRow
  If Cells(i, "O").Value = "OK" And Cells(i, "B").Text = "" Then
   mes = mes & vbCrLf & "売上: " & Cells(i, "B").Address(0, 0) & "空白を確認してください"
   Cells(i, "B").Interior.Color = vbYellow
  End If
 Next i
 If Len(mes) > 4 Then
  mes = mes & vbCrLf
 End If
 For i = 1 To LastRow
  If Cells(i, "O") = "OK" Then
  If IsError(Cells(i, "B")) Then
   mes = mes & vbCrLf & "売上: " & Cells(i, "B").Address(0, 0) & "エラーを確認してください"
   Cells(i, "B").Interior.Color = vbRed
  End If
  End If
 Next i
 MsgBox Mid(mes, 2)
End Sub
    • good
    • 0
この回答へのお礼

助かりました

お二人ともありがとうございました!
早々に答えていただき、お二人ともベストアンサーにしたいのですが
WindFallerさんが本当に理想通りだったので
ベストアンサーにしたいと思います。
ありがとうございました!

お礼日時:2018/01/12 20:01

こんな感じではいかがでしょうか?


--------------------------------------------------------------------------------
Sub macro1()
Dim i As Long
Dim lastrow As Long
Dim エラー有 As Boolean
Range("B:C").Interior.ColorIndex = xlNone
lastrow = Cells(Rows.Count, 15).End(xlUp).Row
For i = lastrow To 1 Step -1
If Cells(i, "O").Value = "OK" Then
If IsError(Cells(i, "B").Value) Then
エラー有 = True
Cells(i, "B").Interior.Color = vbRed
Cells(i, "B").Select
Else
If Cells(i, "B").Value = "" Then
エラー有 = True
Cells(i, "B").Interior.Color = vbRed
Cells(i, "B").Select
End If
End If
End If
Next i
If エラー有 Then
MsgBox ("確認してください")
End If
End Sub
--------------------------------------------------------------------------------
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング