セルがうまく参照されなくて困っています。

質問

シート上、２列目において、０が出てきた時に初めてループを抜けるようにしたいのですが、

Do
If Cells(i, 2) = 0 Then Exit Do
i = i + 1
Loop

とすると、０が出てくる前にループを抜けてしまいます。

どなたかよろしくお願い致します。

回答No.5

fujillin · ベストアンサー

こんばんは。　ざっとしか見てませんが・・・

＞『C:\Documents～～\画像処理２』上にあるシートのセルを参照されているか不安になってきました。
VBエディタ上でブレークポイントを設定しておいて、ウォッチ式でその時の変数の状態を見たり、途中にMsgBox（○○）などを入れておいて内容を確かめるなどの方法で、処理の状態が確認できます。
例えば、いくつのファイルを処理したかは、最後にMsgBox(n-1)を入れておけばわかるはずですよね。
（途中にMsgBox(strFILENAME)入れておけば、都度、対象ファイル名を確認できる）

また、テストの間は、とりあえず
　Application.ScreenUpdating = False　をコメントアウトしておいたほうがVBAの動作が見えますので、良いかも知れません。

当初のご質問の、0を探すループの部分が、「If Cells(i, 2) = 0～」という記述方法なので、ワークブック、シートが明示されてはいませんね。
（明示するなら　Workbook.Worksheet.Cells( , )　のような指定方法になります）
指定がない場合は、どうやらアクティブシートが対象となるようですので、開いたブック（objWBK）のシートが参照されていると思われます。（多分、予定通りですよね？）

などで、確認しながら意図と違う部分を潰していくのが、遠回りなようで近道かも。

少々、疑問なのが、各ブックはみなシートが1枚しかないのだろうか（開いた時にアクティブになったシートが対象になるので）ということ。
後は、前にも書きましたが「0」が見つからない時。多分、セルの範囲を超えて指定することのなるので、エラーになると思いますけれど・・・

補足

詳しく説明していただき本当にありがとうございます。

今回教えていただいたMsgBox(strFILENAME)をループの後に記述し試したところ、参照して欲しいシート名が表示されていましたが、ループ中に参照しているセルは新しく作ったシート（データを書き込むところ）になってしまっている様子でした（試しにそのシートにのセルに０とその他の数字を書き込んでみた所、０でループを抜けていました・・・）

各ブックにはシートは一枚しか無いこと、またMsgBox(strFILENAME）を入れたときに、参照して欲しいファイル名が表示されるにもかかわらず、なぜ新規ブックを参照してしまってるか謎ですが　明日確認してみます。

今回、『０』が無いということはありません。色々教えていただいて本当にうれしいです。

回答No.4

mt2008

ループとは関係ないのですが、2列目に0がある位置を求めるだけならループさせるより、こんな感じで0の位置を探した方がよくないですか？

i = Application.WorksheetFunction.Match(0, Range("B:B"), 0)

お礼

新しい投稿のほうにまで意見をいただけて本当に助かります。

回答No.3

imogasi

Sub test01()
i = 1
Do
MsgBox VarType(Cells(i, 2))
If VarType(Cells(i, 2)) > 2 Then
If Cells(i, 2) = 0 Then Exit Do
i = i + 1
Else
i = i + 1
End If
Loop
MsgBox i & "行目0"
End Sub
VarType(Cells(i, 2))で変数の型を聞く例。
空白ばかりでＬｏｏｐを抜ける場合は上記では間違いだが、そこは改良してください。参考までに。

補足

御助言大変ありがとうございます。
しかしながら、解決することが出来ませんでした。
つきまして、詳しい補足コメントをA　No１の方の欄に記入致しましたので、目を通していただけると　と思います。
よろしくお願いします。

回答No.2

fujillin

どのような使用条件か若干不明ですが・・・

抜ける条件が確実に「0」だけであれば、テキストで取って
　If Cells(i, 2).Text = "0" Then Exit Do
とすれば可能です。
ただし、上記では、0.0などは違う物として判断されます。
空白セルを除くのであれば、そのまま記述して、
　If (Cells(i, 2) <> "") And (Cells(i, 2) = 0) Then Exit Do
でも可能です。

「0」がなかった場合どうなるのかなぁ？（おせっかい失礼）

補足

お力添えありがとうございます。
しかしながら、解決することができませんでした。
０がない場合についても考えさせていただきました。

使用条件等、補足コメントをA　No１の方の欄に記入致しましたので、拝見頂ければと思います。
よろしくお願いいたします。

回答No.1

kawais070

空欄のセルがあるから、ではないですか？

空欄のセルを排除するために、以下のようにしてはいかがでしょうか。

Do
If Len(Cells(i, 2)) > 0 Then
If Cells(i, 2) = 0 Then Exit Do
End If
i = i + 1
Loop

補足

皆様、貴重な意見ありがとうございます。
教えて頂いたことを試してみましたが、解決する事が出来ませんでした。

使用状況は研究データとして出てきたモノを纏める為に必要で、理由は長くなりますので簡潔に纏めると、

１０００枚ほどのシート上２～４列目において、初めて『０』が出てきた行の数字の平均の値を求めたい

といった所です。

一度、教えてGOOに投稿した事がありますが、参考までに、改善前のプログラムを載せてみます。

Option Explicit
Sub syoutotumen()
Dim i As Long
Dim j As Long
Dim k As Long
Dim kyori As Long
Dim n As Integer
n = 1
i = 1
j = 1
k = 1
Const cnsYEN = "\"
Dim swESC As Boolean
Dim ws1 As Worksheet
Dim xlAPP As Application
Dim objWBK As Workbook
Dim strPATHNAME As String
Dim strFILENAME As String
strPATHNAME = "C:\Documents and Settings\tata41\デスクトップ\画像処理２\"
If strPATHNAME = "" Then Exit Sub
strFILENAME = Dir(strPATHNAME & "demo******", vbNormal)

If strFILENAME = "" Then
MsgBox "このフォルダにはExcelワークブックは存在しません"
Exit Sub
End If
Set xlAPP = Application
With xlAPP
.ScreenUpdating = False
.EnableEvents = False
.EnableCancelKey = xlErrorHandler
.Cursor = xlWait
End With
Set ws1 = Worksheets("sheet1")
Range("A1") = "0"
Range("A2") = "1"
Range("A1:A2").Select
Selection.AutoFill Destination:=Range("A1:A1022")
Do While strFILENAME <> ""
DoEvents
If swESC = True Then
If MsgBox("ESCが押されました。ここで終了しますか？", vbInformation + vbYesNo) = vbYes Then
GoTo Button1_Click_Exit
Else
swESC = False
End If
End If
xlAPP.StatusBar = strFILENAME & "処理中・・・"

Set objWBK = Workbooks.Open(Filename:=strPATHNAME & cnsYEN & strFILENAME, UpdateLinks:=False, ReadOnly:=True)

Do

If Cells(i, 2) = 0 Then Exit Do
i = i + 1
Loop

Do
If Cells(j, 3) = 0 Then Exit Do
j = j + 1
Loop

Do
If Cells(k, 4) = 0 Then Exit Do
k = k + 1
Loop

kyori = (i + j + k - 21) / 3
ws1.Cells(n, 2) = kyori
n = n + 1
i = 1
j = 1
k = 1
objWBK.Close savechanges:=False
strFILENAME = Dir
Loop
GoTo Button1_Click_Exit
Button1_Click_ESC:
If Err.Number = 18 Then
swESC = True
Resume
ElseIf Err.Number = 1004 Then
Resume Next
Else
MsgBox Err.Description
End If

Button1_Click_Exit:
With xlAPP
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
.EnableCancelKey = xlInterrupt
.Cursur = xlDefault
Set objWBK = Nothing
Set xlAPP = Nothing
End With
End Sub

としています。

この状態で、『C:\Documents and Settings\tata41\デスクトップ\画像処理２』上にあるシートのセルを参照されているか不安になってきました。

VBAに関して無知の為、また緊急を要している為、お力を貸して頂ければと思います。

よろしくお願い致します。