Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1421 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【74704】アプリケーション定義またはオブジェクト定義のエラーとでてしまいます KK 13/9/1(日) 1:40 質問[未読]
【74705】Re:アプリケーション定義またはオブジェク... Yuki 13/9/1(日) 10:10 発言[未読]
【74707】Re:アプリケーション定義またはオブジェク... KK 13/9/1(日) 11:07 お礼[未読]
【74706】Re:アプリケーション定義またはオブジェク... kanabun 13/9/1(日) 10:19 発言[未読]
【74708】Re:アプリケーション定義またはオブジェク... KK 13/9/1(日) 11:20 お礼[未読]
【74709】Re:アプリケーション定義またはオブジェク... kanabun 13/9/1(日) 11:31 発言[未読]
【74710】Re:アプリケーション定義またはオブジェク... KK 13/9/1(日) 12:56 お礼[未読]
【74704】アプリケーション定義またはオブジェクト...
質問  KK  - 13/9/1(日) 1:40 -
引用なし
パスワード
   I列を検索していき
数値が入っていなければ
1から順にS列に番号を振っていき
endが入ってるセルまでそれを続ける

という内容で組もうと思ったのですが
下記の通りに作ってみたのですが
とちゅうでアプリケーション定義またはオブジェクト定義のエラーと表示され
1行目に1が入ったところで止まります
どのように修正したらいいか教えていただけたら幸いです

Sub 番号振り()
　　Range("I2").Select
　　Do Until ActiveCell.Value = "end"
　　　　If IsNumeric(ActiveCell.Value) Then
　　　　　　Dim K As Integer
　　　　　　For K = 1 To 1000
　　　　　　　　ActiveCell.Offset(0, 10).Value = K
　　　　　　　　ActiveCell.Offset(0, -10).Select
　　　　　　Next K
　　　　End If
　　　　ActiveCell.Offset(1, 0).Select
　　Loop
End Sub
【74705】Re:アプリケーション定義またはオブジェ...
発言  Yuki  - 13/9/1(日) 10:10 -
引用なし
パスワード
   ▼KK さん：

こんにちは。

>I列を検索していき
>数値が入っていなければ
>1から順にS列に番号を振っていき
>endが入ってるセルまでそれを続ける
>
>という内容で組もうと思ったのですが
>下記の通りに作ってみたのですが
>とちゅうでアプリケーション定義またはオブジェクト定義のエラーと表示され
>1行目に1が入ったところで止まります

>
>Sub 番号振り()
>　　Range("I2").Select
>　　Do Until ActiveCell.Value = "end"
>　　　　If IsNumeric(ActiveCell.Value) Then
>　　　　　　Dim K As Integer
>　　　　　　For K = 1 To 1000
>　　　　　　　　ActiveCell.Offset(0, 10).Value = K

此処でエラー　　↓　列が 9 なのに -10 しているからエラー
>　　　　　　　　ActiveCell.Offset(0, -10).Select
>　　　　　　Next K
>　　　　End If
>　　　　ActiveCell.Offset(1, 0).Select
>　　Loop
>End Sub

ところで
　　　　　　Dim K As Integer
　　　　　　For K = 1 To 1000
　　　　　　　　ActiveCell.Offset(0, 10).Value = K
　　　　　　　　ActiveCell.Offset(0, -10).Select
　　　　　　Next K
は何のためにするのですか？
I列が数値でなかったらS列に連番をとは全然違いますが。

Sub 番号振りA()
　　Dim K　 As Long
　　Dim i　 As Long
　　i = 2
' end があるまで Loop
　　Do Until Cells(i, 9).Value = "end"
　　　' 数値でなかったら　
　　　If Not IsNumeric(Cells(i, 9).Value) Then
　　　　　　K = K + 1
　　　　　　' S 列に連番を入れる
　　　　　　Cells(i, 9).Offset(0, 10).Value = K
　　　　End If
　　　　i = i + 1
　　Loop
End Sub

Do Loop で処理するとこんな感じですか？
【74706】Re:アプリケーション定義またはオブジェ...
発言  kanabun  - 13/9/1(日) 10:19 -
引用なし
パスワード
   ▼KK さん：

>とちゅうでアプリケーション定義またはオブジェクト定義のエラーと表示され
>1行目に1が入ったところで止まります

>　　Do Until ActiveCell.Value = "end"
>　　　　If IsNumeric(ActiveCell.Value) Then
>　　　　　　Dim K As Integer
>　　　　　　For K = 1 To 1000
>　　　　　　　　ActiveCell.Offset(0, 10).Value = K
>　　　　　　　　ActiveCell.Offset(0, -10).Select
>　　　　　　Next K
>　　　　End If
>　　　　ActiveCell.Offset(1, 0).Select
>　　Loop

すざましいことをしていますね!?!?
アプリケーション定義エラーの直接の原因は ◆ の行にあります。
>　　　　　　For K = 1 To 1000
>　　　　　　　　ActiveCell.Offset(0, 10).Value = K
>　　　　　　　　ActiveCell.Offset(0, -10).Select　'◆
>　　　　　　Next K

いまLoopの最初のセルは[I2]です。ここがActiveCellです。
ここに数値が入っているか、空白ですと、プログラムの実行は
ActiveCell.Offset(0, 10) セルに 1000回 値K を書き込む処理をしています。
（何のために 1000回 同じセルに書き込む必要があるのか？ ここも疑問ですけど）

たとえば そこを
繰り返しなしで
　　　　　　　　 K = K + 1
>　　　　　　　　ActiveCell.Offset(0, 10).Value = K
>　　　　　　　　ActiveCell.Offset(0, -10).Select　'◆

と修正したとしましょう。
それでもエラーは出ます。
理由は ◆のところで [I2]セルから 10列左 のセルを Select しなさい、
となっているからです。I列から 10列左のセル なんてないですよね？

こういうのは、 最初に "end" のあるセルを Findメソッドか Worksheetの
Match関数で見つけておいて [I2] から その"end" のあるセルのひとつ上の
セルまで For Each Next で Loopするとしたほうが分りやすいし、効率的です。

それから、さっきも言いましたが、

Dim c As Range
For Each c In Range([I2:I30]
>　　 If IsNumeric(c.Value) Then

IsNumericは数値化可能かどうか調べる関数で、空白セルも（0に数値化可能
なので）IsNumeric(空白セル.Value) は True になります。
ここは2重のIf文にして、
最初に If Not IsEmpty(c.Value) Then で 空白セルでないことを判断し、
その中で（空白セルでないときのみ）
　　　　　If IsNumeric(c.Value) Then
とすべきです。

他にもありますが、とりあえず、この辺りを再調査してコーディングして
みてください。
【74707】Re:アプリケーション定義またはオブジェ...
お礼  KK  - 13/9/1(日) 11:07 -
引用なし
パスワード
   Yukiさん
早速の返信ありがとうございます

>Sub 番号振りA()
>　　Dim K　 As Long
>　　Dim i　 As Long
>　　i = 2
>' end があるまで Loop
>　　Do Until Cells(i, 9).Value = "end"
>　　　' 数値でなかったら　
>　　　If Not IsNumeric(Cells(i, 9).Value) Then
>　　　　　　K = K + 1
>　　　　　　' S 列に連番を入れる
>　　　　　　Cells(i, 9).Offset(0, 10).Value = K
>　　　　End If
>　　　　i = i + 1
>　　Loop
> End Sub
>
>Do Loop で処理するとこんな感じですか？

こちらを参考にして
Sub 番号振り()
　　Dim K As Integer
　　K = 1
　　Range("I2").Select
　　Do Until ActiveCell.Value = "end"
　　　　If Not IsEmpty(ActiveCell.Value) Then
　　　　　　If IsNumeric(ActiveCell.Value) Then
　　　　　　ActiveCell.Offset(0, 10).Value = K
　　　　　　K = K + 1
　　　　　　End If
　　　　End If
　　　　ActiveCell.Offset(1, 0).Select
　　Loop
End Sub

というように組んでみたら無事に作動しました
ありがとうございました
【74708】Re:アプリケーション定義またはオブジェ...
お礼  KK  - 13/9/1(日) 11:20 -
引用なし
パスワード
   ▼kanabun さん：
>それから、さっきも言いましたが、
>
>Dim c As Range
>For Each c In Range([I2:I30]
>>　　 If IsNumeric(c.Value) Then
>
>IsNumericは数値化可能かどうか調べる関数で、空白セルも（0に数値化可能
>なので）IsNumeric(空白セル.Value) は True になります。
>ここは2重のIf文にして、
>最初に If Not IsEmpty(c.Value) Then で 空白セルでないことを判断し、
>その中で（空白セルでないときのみ）
>　　　　　If IsNumeric(c.Value) Then
>とすべきです。

こちらを参考に
Sub 番号振り()
　　Dim K As Integer
　　K = 1
　　Range("I2").Select
　　Do Until ActiveCell.Value = "end"
　　　　If Not IsEmpty(ActiveCell.Value) Then
　　　　　　If IsNumeric(ActiveCell.Value) Then
　　　　　　ActiveCell.Offset(0, 10).Value = K
　　　　　　K = K + 1
　　　　　　End If
　　　　End If
　　　　ActiveCell.Offset(1, 0).Select
　　Loop
End Sub

早速こちらを参考にして組んでみたところ、無事に必要な全ての行に番号を振ることが出来ました。
投稿後も試行錯誤をしていたのですが、2重のIF文にしておらずうまくいかなかったので、
とても今後の参考になりました。
ありがとうございました。
【74709】Re:アプリケーション定義またはオブジェ...
発言  kanabun  - 13/9/1(日) 11:31 -
引用なし
パスワード
   ▼KK さん：

>早速こちらを参考にして組んでみたところ、無事に必要な全ての行に番号を振ることが出来ました。
>投稿後も試行錯誤をしていたのですが、2重のIF文にしておらずうまくいかなかったので、
>とても今後の参考になりました。

If文でのチェックはそれで OK ですが、
あと、Select や ActiveCell を使わないコードを心がけましょう♪

Sub Sample番号ふり()
　Dim k As Long
　Dim m
　Dim c As Range
　
　m = Application.Match("end", [I:I], 0)
　If IsNumeric(m) Then
　　　For Each c In Range("I2:I" & m - 1)
　　　　　If Not IsEmpty(c.Value) Then
　　　　　　　If IsNumeric(c.Value) Then
　　　　　　　　　k = k + 1
　　　　　　　　　c.Offset(, 10).Value = k
　　　　　　　End If
　　　　　End If
　　　Next c
　Else
　　　MsgBox "I列に <end> がありません", vbCritical
　End If
End Sub
【74710】Re:アプリケーション定義またはオブジェ...
お礼  KK  - 13/9/1(日) 12:56 -
引用なし
パスワード
   kanabun さん

より丁寧に教えていただいてありがとうございます。
VBA始めたばかりなので徐々にきれいに組めるようにがんばっていきたいと思います。
教えていただいたコードをしっかり読み込んで自分でも使えるようにしていきたいと思います。
このたびはありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1421 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free