プロが教える店舗&オフィスのセキュリティ対策術

VBAに慣れていないのですが、下記のマクロを組んでみました。
実行すると、コンパイルエラー Nextに対するForがありませんと出てしまいました。
原因が良く解らないので解る方いらっしゃいましたら教えてください。

それと、もっと良い書き方などありましたらアドバイスを下さい。
よろしくお願いします。

Sub レポート作成2each()
Dim ReportMaxRow As Long '上方向に最終行を検索し行番号を格納
Dim AddWsName As String 'シート名格納
Dim Ws As Worksheet 'オブジェクト格納
Dim i As Long '繰り返しのカウントを格納
Dim flag As Boolean '真偽

ReportMaxRow = Worksheets("レポート元").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To ReportMaxRow
If Cells(i, "N").Value <> "" Then
If Cells(i, "O").Value <> "" Then
AddWsName = Cells(i, "K").Value

For Each Ws In Worksheets
If Ws = AddWsName Then
flag = True
Next Ws   ←ここでエラーになります。

If flag = True Then
Worksheets("レポート元").Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
Worksheets.Add
ActiveWorksheet.Name = AddWsName
Worksheets("レポート元").Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If

MsgBox i + "行目の発注数の入力がませんでした。" & vbNewLine & "処理を中断します, _
vbOKOnly + vbExclamation, "お知らせ"
End If
Else
MsgBox i + "行目の発注数の入力がませんでした。" & vbNewLine & "処理を中断します", _
vbOKOnly + vbExclamation, "お知らせ"
End If
Next i
End Sub

A 回答 (4件)

NO3です。


(1)追加したFlagのリセットが誤っておりますので訂正します。
   Flag = False
(2)回答コードのシート名はシミュレート用に変更していますので元に戻して下さい。
    • good
    • 0
この回答へのお礼

お返事ありがとうございます。

御丁寧にソースまで作成ありがとうございました。
構築のやり方など大変参考になりました。
ありがとうございました。

また質問した際はよろしくお願いいたします。

お礼日時:2011/11/18 11:31

一例です。


・Msgboxの変更
・Wsのプロパティ追加
・Endifの追加
・不要なループの削除(Exit For追加)
・Flagのリセット追加
 
ReportMaxRow = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ReportMaxRow
If Cells(i, "N").Value = "" Or Cells(i, "O").Value = "" Then
MsgBox i & "行目の発注数の入力がませんでした。" & vbCrLf & "処理を中断します", _
vbOKOnly + vbExclamation, "お知らせ"
Else
AddWsName = Cells(i, "K").Value
For Each Ws In Worksheets
If Ws.Name = AddWsName Then
Exit For
End If
Next
If flag Then
Worksheets("sheet1").Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
flag = True

Else
Worksheets.Add
ActiveWorksheet.Name = AddWsName
Worksheets("sheet1").Cells(i, 1).EntireRow.Copy _
Destination:=Worksheets(AddWsName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End If
Next i
    • good
    • 0

>実行時エラー 438 オブジェクトは、このプロパティまたはメソッドをサポートしていません。



このエラーは

>Dim AddWsName As String 'シート名格納
>Dim Ws As Worksheet 'オブジェクト格納

こうなって

>If Ws = AddWsName Then 

こうなってる以上当たり前です。
"="の左右は同じ属性じゃないと比較できません。

確認してませんが多分

>If Ws.Name = AddWsName Then

で動くんじゃないかと。

この回答への補足

お返事ありがとうございます。
そうでした^^;ご指摘ありがとうございました。

補足日時:2011/11/17 00:08
    • good
    • 0

>For Each Ws In Worksheets


>If Ws = AddWsName Then
>flag = True
ここにEnd Ifがないから
>Next Ws   ←ここでエラーになります。

この回答への補足

早いお返事ありがとうございます。早速直してみましたが、
実行時エラー 438 オブジェクトは、このプロパティまたはメソッドをサポートしていません。
と出てしまいました。
どこが問題なのでしょうか…変数AddWsNameを入れる事が出来ないのでしょうか?

For Each Ws In Worksheets
 If Ws = AddWsName Then ←ここが黄色でマークされています。
  flag = True
 End If
Next Ws

補足日時:2011/11/16 14:00
    • good
    • 0

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