では、先ほどの While…Wend文の実務寄り問題（在庫管理・名簿処理・データ検証） を Do…Loop版に書き換えた模範解答 をまとめます。
「先判定（Do While … Loop）」と「後判定（Do … Loop While）」の両方を示します。
在庫管理系
問題1: 在庫数が0以下の商品に「要発注」と記録
先判定
Sub 在庫チェック_DoWhile()
Dim row As Long
row = 2
Do While Cells(row, 1).Value <> ""
If Cells(row, 2).Value <= 0 Then
Cells(row, 3).Value = "要発注"
End If
row = row + 1
Loop
End Sub
後判定
Sub 在庫チェック_DoLoopWhile()
Dim row As Long
row = 2
Do
If Cells(row, 2).Value <= 0 Then
Cells(row, 3).Value = "要発注"
End If
row = row + 1
Loop While Cells(row, 1).Value <> ""
End Sub
問題2: 発注リストを在庫表に反映
先判定
Sub 発注反映_DoWhile()
Dim wsStock As Worksheet, wsOrder As Worksheet
Dim orderRow As Long, stockRow As Long
Set wsStock = Sheets("在庫表")
Set wsOrder = Sheets("発注リスト")
orderRow = 2
Do While wsOrder.Cells(orderRow, 1).Value <> ""
Dim code As String, qty As Long
code = wsOrder.Cells(orderRow, 1).Value
qty = wsOrder.Cells(orderRow, 2).Value
stockRow = 2
Do While wsStock.Cells(stockRow, 1).Value <> ""
If wsStock.Cells(stockRow, 1).Value = code Then
wsStock.Cells(stockRow, 2).Value = wsStock.Cells(stockRow, 2).Value + qty
Exit Do
End If
stockRow = stockRow + 1
Loop
If wsStock.Cells(stockRow, 1).Value = "" Then
wsStock.Cells(stockRow, 1).Value = code
wsStock.Cells(stockRow, 2).Value = qty
End If
orderRow = orderRow + 1
Loop
End Sub
名簿処理系
問題3: 20歳未満に「未成年」と記録
先判定
Sub 未成年チェック_DoWhile()
Dim row As Long
row = 2
Do While Cells(row, 1).Value <> ""
If Cells(row, 2).Value < 20 Then
Cells(row, 3).Value = "未成年"
End If
row = row + 1
Loop
End Sub
後判定
Sub 未成年チェック_DoLoopWhile()
Dim row As Long
row = 2
Do
If Cells(row, 2).Value < 20 Then
Cells(row, 3).Value = "未成年"
End If
row = row + 1
Loop While Cells(row, 1).Value <> ""
End Sub
問題4: 部署名が空欄なら「部署未登録」と記録
先判定
Sub 部署チェック_DoWhile()
Dim row As Long
row = 2
Do While Cells(row, 1).Value <> ""
If Cells(row, 2).Value = "" Then
Cells(row, 3).Value = "部署未登録"
End If
row = row + 1
Loop
End Sub
データ検証系
問題5: 売上金額が負なら「エラー」と記録
先判定
Sub 売上検証_DoWhile()
Dim row As Long
row = 2
Do While Cells(row, 1).Value <> ""
If Cells(row, 2).Value < 0 Then
Cells(row, 3).Value = "エラー"
End If
row = row + 1
Loop
End Sub
問題6: メールアドレスに「@」がなければ「不正」と記録
先判定
Sub メール検証_DoWhile()
Dim row As Long
row = 2
Do While Cells(row, 1).Value <> ""
If InStr(Cells(row, 1).Value, "@") = 0 Then
Cells(row, 2).Value = "不正"
End If
row = row + 1
Loop
End Sub
✅ まとめ
- While…Wend → 古い書き方、単純な繰り返しに使える
- Do…Loop → 柔軟で実務向き（途中終了
Exit Doが可能、条件の位置を選べる） - 実務では「在庫表チェック」「名簿処理」「データ検証」などで、Do…Loopを使う方が安全で拡張性が高い
