Excelのマクロで条件を指定して、自動処理する方法。

質問

Excelのマクロで条件を指定して、自動処理する方法。
こんにちは。
条件を指定して自動処理したいのですが、
どのようにしたらよいかわからず困っています。
よろしくお願いします。

　　　　A　　　　B

１　　　α　　　○　　　　　　　　　　　　　　　　　　　　　　

２　　　β

３

エクセルの表で、A1セルが空白か否か

Ａ１セルが
空白の場合→終了
記入してある場合→B１セルが空白か否か

Ｂ１セルに○が
記入してある場合→Ａ２セルへ
空白の場合→「ファイル情報リスト作成マクロ（既に作成済み）」を使ってリストを自動作成
　　　　　　　　　→リスト作成が終わったらＢ１セルに○印を付ける
　　　　　　　　　→Ａ２セルへ

Ａ２セルが空白か否か…（繰り返し）

「ファイル情報リスト作成マクロ」は、文字数の許す限りで以下に示します。
こちらも相談箱を参考にさせて頂いたものです。

「ファイル情報リスト作成マクロ」
Sheet1 の A1 セルに調べたいフォルダ名を入力して
標準モジュールに貼り付けて、マクロ makeFileList を実行
Sheet2にリスト出力

Sub makeFileList()
　　Call fileList
　　MsgBox "終了しました"
Columns.AutoFit 'すべての列幅を自動調整する
End Sub

Function fileList(Optional trgDir As String = "", Optional fCnt As Long = 0)
　　On Error GoTo err
　　Dim objFs As Object
　　Dim objDir As Object
　　Dim objFile As Object
　　Dim i As Long

　　Set objFs = CreateObject("Scripting.FileSystemObject")

　　If trgDir = "" Then
　　　　Set objDir = objFs.Getfolder(Sheets("sheet1").Range("a1"))
　　Else
　　　　Set objDir = objFs.Getfolder(trgDir)
　　End If

　　Set objFile = objDir.Files

　　With Sheets("sheet2")
　　　　For Each objFile In objDir.Files
　　　　　　　　fCnt = fCnt + 1
.Cells(fCnt, 1).Offset(1, 0) = fCnt
.Cells(fCnt, 2).Offset(1, 0) = objFile.DateCreated
.Cells(fCnt, 3).Offset(1, 0) = objFile.DateLastModified
.Cells(fCnt, 4).Offset(1, 0) = objFile.Path
.Range("A1").Value = "Ｎｏ"
.Range("B1").Value = "作成日"
.Range("C1").Value = "更新日"
.Range("D1").Value = "ファイル名"
　　　　Next objFile

　　　　For Each objDir In objDir.SubFolders
　　　　　　If objDir.Attributes <> 22 Then　　 'システムフォルダ除外

　　　　　　　　　　'--------------サブフォルダの再帰検索
　　　　　　　　　　　　Call fileList(objDir.Path, fCnt)
　　　　　　　　　　'--------------サブフォルダの再帰検索

　　　　　　End If
　　　　Next objDir
　　End With

　　Set objFile = Nothing
　　Set objDir = Nothing
　　Set objFs = Nothing
Exit Function

err:
　　Select Case err.Number
　　　　Case 76 ' path がない
　　　　　　MsgBox "path 指定が間違っています"

回答No.2

ichhabehunger · ベストアンサー

こんにちは。

要するに、A列を見て処理が済んでいれば「○」と書いてあるので、
処理が済んでいなければ処理をして（「ファイル情報リスト作成マクロ」を動かす）
A列の最後までやれ、ってことですね。

「ファイル情報リスト作成マクロ」の内容は申し訳ないが見る気がしないので
処理のループだけ（Excel VBA はほんと久しぶり！）
このような処理の場合、セルを１個１個見ていくのが Excel にとっては
一番遅い処理なので、A列B列はいったんメモリ上の配列に取り込んで処理するといいです。
そして、書き込みも一度にやってしまうのです。
ただし、「ファイル情報リスト作成マクロ」のスピードが遅ければだめですけど。

Option Explicit

Sub test()
Dim MyR As Range
Dim buf As Variant
Dim r As Long

Set MyR = Range("A1").CurrentRegion
buf = MyR.Value
For r = 1 To MyR.Rows.Count
If buf(r, 2) <> "○" Then
ファイル情報リスト作成マクロ
buf(r, 2) = "○"
End If
Next
MyR.Value = buf
End Sub
Sub ファイル情報リスト作成マクロ()
Debug.Print "呼ばれたかい？"
End Sub

補足

こんにちは。
回答ありがとうございました。
マクロを実行したところ、
「ファイル情報リスト」を作成していないところでも
A列に何か記入があると「○」を記入してしまいます。
「ファイル情報リスト」は別シート又はC列のセルに記入しようと思っているのですが、
「ファイル情報リスト」が記入されて初めて「○」が記入されるようにする方法は
何かご存じでしょうか。教えてください。
補足説明がわかりずらかったらごめんなさい。

回答No.4

ichhabehunger

コードを見ていただければわかるのですが
「○」以外は「ファイル情報リスト作成マクロ」が走るようになっています。

あなたの説明の場合、B列が○の場合と空欄の場合しか書いてなく、
それ以外の場合の情報がないのです。
ですから念のため○以外は「ファイル情報リスト作成マクロ」が走るようにしました。

情報の提示不足です。

コードの

If buf(r, 2) <> "○" Then

ってところを

f buf(r, 2) = "" Then

と変えればいいと思います。

お礼

ありがとうございました。
理解できました。
ＶＢの知識はほとんどなく、頼りきりで申し訳ありません。
助かりました。

回答No.3

kmetu

ANo1です
繰り返しの終了条件が不明
と思ったけど
Axセルが空白の場合→終了
でしたね

空白の場合終了とすると

Dim i As Long

i = 1
While Range("a" & i).Value <> ""
If Range("b" & i).Value = "" Then
'空白の場合→「ファイル情報リスト作成マクロ（既に作成済み）」を使ってリストを自動作成
'リスト作成が成功したかどうかの判断が必要
'If リスト作成が成功 Then
Range("B" & i).Value = "○"
'else
'　リスト作成が成功しなかった場合の処理　exit sub?
'End If
ElseIf Range("b" & i).Value <> "○" Then
'○以外の何かが記入されている場合の説明がないのでとりあえず終了
Exit Sub
End If
i = i + 1
Wend

お礼

わかりやすくご説明も添えていただきありがとうございました。
早急に対応いただき、とても助かりました。
使わせていただいております。
ほんとうにありがとうございま。

回答No.1

kmetu

Dim mLoopCount As Integer
Dim i As Integer

mLoopCount = 10 'どこまで繰り返すのか分からないので取り合えず10回

For i = 1 To mLoopCount

'A1セルが
'空白の場合→終了
If Range("a" & i).Value = "" Then
Exit Sub

'記入してある場合→B1セルが空白か否か
ElseIf Range("b" & i).Value = "" Then
'空白の場合→「ファイル情報リスト作成マクロ（既に作成済み）」を使ってリストを自動作成

' →リスト作成が終わったらB1セルに○印を付ける
'リスト作成が成功したかどうかの判断が必要
'If リスト作成が成功 Then
Range("B" & i).Value = "○"
'else
'　リスト作成が成功しなかった場合の処理　exit sub?
'End If

ElseIf Range("b" & i).Value <> "○" Then
'○以外の何かが記入されている場合の説明がないのでとりあえず終了
Exit Sub
End If

'B1セルに○が
'記入してある場合→A2セルへ
' →A2セルへ
'
'Ａ２セルが空白か否か…（繰り返し）繰り返しの終了条件が不明
Next i

とりあえずこんな感じでいかがでしょう。