期限切れのマテリアルアシスタンスに対して警告するVBAコード

Question

エクセルファイルを開くとすぐにポップアップウィンドウを作成しようとしています。

私が持っているExcelブックは、複数のシートを持っています。

シートの1つに「在庫」というタイトルが付けられています。

以下の図に示すように、[在庫]タブには[有効期限までの日数]という列があります。

ブックを開くときにExcelファイルにポップアップが表示されます。このポップアップでは、[在庫]タブの[有効期限までの日数]列がチェックされ、「タイプ欄」の「____マテリアル」のようなものが有効期限まで「____」日かかります。

これは、「有効期限までの日数」の値が0〜14日の場合にのみ発生します。

「有効期限までの日数」の数値が負の場合、「___材料が期限切れになった」というメッセージが表示されます。

私がこれまで持っていたものは次のとおりです。私はworkbook_open（）イベントを作成し、このコードは "ThisWorkbook"コードタブにあります。私は以下の持っているものを実行するとき

私はまた、具体的言って、エラーを取得しています：

ファイル名を指定して実行時エラー '13'：型が一致しません

Private Sub Workbook_Open() 



Application.WindowState = xlMaximized 

     Dim wb As Workbook 
     Dim ws As Worksheet 
     Dim rngUsed As Range, rngExpirationColumn As Range, rngCell As Range 
     Dim strExpirationMessage As String 

     Set wb = ThisWorkbook 
     Set ws = wb.Sheets("Inventory") 
     Set rngUsed = ws.UsedRange 
     Set rngExpirationColumn = Intersect(ws.Columns(4), rngUsed) 

     For Each rngCell In rngExpirationColumn.Cells 
      If Date - CDate(rngCell.Value2) >= 14 Then 
       If Len(strExpirationMessage) = 0 Then 
        strExpirationMessage = rngCell.Offset(0, -3).Value2 & " material has " & (Date - CDate(rngCell.Value2)) & " days left before expiration" 
       Else 
        strExpirationMessage = strExpirationMessage & Chr(13) & rngCell.Offset(0, -3).Value2 & " material has " & (Date - CDate(rngCell.Value2)) & " days left before expiration" 
       End If 
      End If 
     Next 

     MsgBox strExpirationMessage 

End Sub 

Answer 1

私はあなたの要求といくつかの前提に基づいて、次のようにこの回答を投稿しています：

あなたは（あなたの要求に従って）ポップアップに追加するコラム「タイプ」からデータを取得したいあなたは（あなたの要求に従って）コラム「有効期限までの日数」のデータを確認したい
• 有効期限日がコラム「有効期限までの日数」の未満0
• 値がある場合は、別のメッセージをしたい
0〜14有効期限日がある場合は、一つのメッセージをしたい番号（これは仮定であるが、実際にあります、データが提供されていないため）
• 「有効期限までの日数」がマージされていると仮定しています上記の仮定に基づいてコードを（テストさ（スクリーンショットあたり）二列
• に私はあなたのデータはあなたのスクリーンショットから行の真下にあると仮定していますので、おそらくあなたの実際のデータはここで

行4で開始します、原因シナリオを再現するために、実際のデータ）の不足：

Private Sub Workbook_Open() 

    Application.WindowState = xlMaximized 

    Dim ws As Worksheet 
    Dim strExpirationMessage As String 
    Dim rngExpirationCell As Range, rngTypeCell As Range 
    Dim lngRow As Long, lngExpirationCol As Long, lngTypeCol As Long 

    Set ws = ThisWorkbook.Worksheets("Inventory") 
    Set rngExpirationCell = ws.UsedRange.Find(What:="Days Until Expiration", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 
    Set rngTypeCell = ws.UsedRange.Find(What:="Type", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 

    If Not rngExpirationCell Is Nothing And Not rngTypeCell Is Nothing Then 
     lngExpirationCol = rngExpirationCell.Column 
     lngTypeCol = rngTypeCell.Column 

     For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count 
      With ws.Cells(lngRow, lngExpirationCol) 

       If 0 <= .Value And .Value <= 14 Then 
        strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf 
       ElseIf .Value < 0 Then 
        strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf 
       End If 

      End With 
     Next 

     strExpirationMessage = Left(strExpirationMessage, Len(strExpirationMessage) - 2) 'to remove trailing vbCrLf 
     MsgBox strExpirationMessage 

    End If 

End Sub 

重要な注意事項：

• 私は」一部の変数を削除し、代わりに他の変数を使用することで、ロジックの一部を変更しました。
• 範囲オブジェクトではなく、指定されたセルを使用しています
• 固定列とオフセットを使用するのではなく、「有効期限までの日数」と「タイプ」の動的検索を実行していますあなたはコードを変更することなく将来的に列の位置を変更することができます。
• 「有効期限までの日数」が2つの行（スクリーンショットあたり）にマージされていると仮定しています。そのため、私はForループでrngExpirationCell.row + 2を使用しています。それ以外のものがあれば、コードを変更する必要があります。

これがあなたのニーズに合っていることを望みます。問題や懸念があれば教えてください。 この投稿があなたの質問に答える場合は、その左側のチェックマークをクリックして受け入れてください。

更新：あなたが見つかった問題に基づいて
、以下のように使用できForループの2つの代替ソリューションです。それ以外はまったく同じでなければなりません。ただ、以下のロジックのいずれかでForループを交換し、あなたはあなたが空のセルを見つけたら、ロジックを残したいと仮定すると、

を行くために良いことがあります：

For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count 
    With ws.Cells(lngRow, lngExpirationCol) 
     If IsEmpty(.Value) Then Exit For 'Will leave the For loop once an Empty cell is found 

     If 0 <= .Value And .Value <= 14 Then 
      strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf 
     ElseIf .Value < 0 Then 
      strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf 
     End If 

    End With 
Next 

は、あなたが評価をスキップしたいと仮定すると、空のセルについては、使用範囲の終わりまでセルをチェックし続けます。

For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count 
    With ws.Cells(lngRow, lngExpirationCol) 
     If Not IsEmpty(.Value) Then 'Will skip empty cells but continuing validation until the end of the Used Range 
      If 0 <= .Value And .Value <= 14 Then 
       strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf 
      ElseIf .Value < 0 Then 
       strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf 
      End If 
     End If 

    End With 
Next