[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA条件分岐がうまくでいない』(トリちゃん)
こんにちは。
条件分岐がうまくできず困っております。
対象シートがない場合、未完了とセルに入力したいです。
対象シートがあった場合、一度は完了と記入されますが、その後未完了と上書きされてしまい、C列すべて未完了と記入されてしまいます。
どなたかご教授ください。
よろしくお願いいたします。
Sub test()
Dim wbList As Workbook, wbDel As Workbook, wbMaster As Workbook
Dim ws As Worksheet, wsList As Worksheet, wsDel As Worksheet
Dim Path01 As String, Path02 As String, TargetName As String, C As String
Dim LastRow As Long, i As Long
Dim targetSheet As Variant
Set wbMaster = ThisWorkbook
'Ph.G対象者リストを開く
MsgBox "ALL_Ph.G対象者リストを選んでください"
Path01 = Application.GetOpenFilename
Set wbList = Workbooks.Open(Path01)
Set wsList = wbList.Worksheets("※編集禁止※ALL(数式あり)")
'代理店配信シートを開く
MsgBox "代理店配信用シートを選んでください"
Path02 = Application.GetOpenFilename
Set wbDel = Workbooks.Open(Path02)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'代理店マスタを元に、配信用シートを特定し、Ph.G対象者リストからコピー&ペースト
With wbMaster.Worksheets(1)
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
For Each targetSheet In wbDel.Worksheets
For i = 2 To LastRow TargetName = .Cells(i, "B").Value If targetSheet.Name = TargetName Then Set wsDel = wbDel.Worksheets(TargetName) wsDel.Range("A4:E" & wsDel.Cells(Rows.Count, "E").End(xlUp).Row).ClearContents wsList.Range("A1").AutoFilter 2, "〇" wsList.Range("A1").AutoFilter 30, TargetName wsList.Range("J5:N" & wsList.Cells(Rows.Count, "N").End(xlUp).Row).Copy wbDel.Worksheets(TargetName).Range("A4").PasteSpecial xlPasteValues .Cells(i, "C").Value = "完了" Debug.Print C Else .Cells(i, "C").Value = "未完了" Debug.Print C End If Next i Next End With
Application.CutCopyMode = False
wbList.Close SaveChanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
< 使用 Excel:Microsoft365、使用 OS:Windows11 >
条件分岐じゃなくて、ループが二重になってるだけじゃないかなぁ For i = 2 To LastRow For Each targetSheet In wbDel.Worksheets テスト環境も構築できてないから、ぶっつけになるけどステップ実行で様子見てもらえます?
Option Explicit
Sub test() Dim wbList As Workbook, wbDel As Workbook, wbMaster As Workbook Dim ws As Worksheet, wsList As Worksheet, wsDel As Worksheet Dim Path01 As String, Path02 As String, TargetName As String Dim LastRow As Long, i As Long Set wbMaster = ThisWorkbook
'Ph.G対象者リストを開く MsgBox "ALL_Ph.G対象者リストを選んでください" Path01 = Application.GetOpenFilename Set wbList = Workbooks.Open(Path01) Set wsList = wbList.Worksheets("※編集禁止※ALL(数式あり)")
'代理店配信シートを開く MsgBox "代理店配信用シートを選んでください" Path02 = Application.GetOpenFilename Set wbDel = Workbooks.Open(Path02)
'代理店マスタを元に、配信用シートを特定し、Ph.G対象者リストからコピー&ペースト Set ws = wbMaster.Worksheets(1) LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
'マスタシートのB列を2行目からループ処理 For i = 2 To LastRow Stop '★ステップ実行してください。 '対象者をマスターシートから変数に入れる TargetName = ws.Cells(i, "B").Value
'wsDELに対象者のシートがあるかチェックし、シートがあれば処理を続ける wbDel.Activate If Evaluate("ISREF(" & TargetName & "!A1)") = True Then Set wsDel = wbDel.Worksheets(TargetName) wsDel.Range("A4:E" & wsDel.Cells(Rows.Count, "E").End(xlUp).Row).ClearContents
'フィルター結果のコピー With wsList With .Range("A1") .AutoFilter 2, "〇" .AutoFilter 30, TargetName End With .Range("J5:N" & .Cells(Rows.Count, "N").End(xlUp).Row).Copy End With
'wsDelに結果を書き込み wsDel.Range("A4").PasteSpecial xlPasteValues Application.CutCopyMode = False
'マスターに結果を入力 ws.Cells(i, "C").Value = "完了" Else ws.Cells(i, "C").Value = "未完了" End If Next i Application.ScreenUpdating = True
'ブックを閉じる Application.DisplayAlerts = False wbList.Close SaveChanges:=False Application.DisplayAlerts = True End Sub
(稲葉) 2023/01/27(金) 12:40:48
.Range(.Cells(2, "C"),.Rells(LastRow,"C")).Value = "未完了" For Each targetSheet In wbDel.Worksheets For i = 2 To LastRow TargetName = .Cells(i, "B").Value If targetSheet.Name = TargetName Then Set wsDel = wbDel.Worksheets(TargetName) wsDel.Range("A4:E" & wsDel.Cells(Rows.Count, "E").End(xlUp).Row).ClearContents wsList.Range("A1").AutoFilter 2, "〇" wsList.Range("A1").AutoFilter 30, TargetName wsList.Range("J5:N" & wsList.Cells(Rows.Count, "N").End(xlUp).Row).Copy wbDel.Worksheets(TargetName).Range("A4").PasteSpecial xlPasteValues .Cells(i, "C").Value = "完了" Debug.Print C End If Next i Next (お邪魔します) 2023/01/27(金) 13:05:07
>Set wsDel = wbDel.Worksheets(TargetName)
ループして探さなくても、ダメもとで変数に入れてみるといいかと。。。。
Option Explicit
Sub test()
Dim wbBase As Workbook Dim wbResults As Workbook Dim rngList As Range Dim c As Range Dim wsTarget As Worksheet Dim a As String
Set wbBase = Workbooks("???") Set wbResults = Workbooks("???")
With ThisWorkbook.Worksheets(1) Set rngList = Application.Range(.Cells(2, "A"), .Cells(Cells.Count).End(xlUp), "A") End With
For Each c In rngList On Error Resume Next Set wsTarget = wbResults.Worksheets(c.Value) '★ダメ元で代入(エラーなら無視する) On Error GoTo 0
If wsTarget Is Nothing Then a = "未完了" Else With wsTarget.UsedRange Intersect(.Cells, .Offset(3)).ClearContents End With
With wbBase.Worksheets("※編集禁止※ALL(数式あり)").Range("A1").CurrentRegion .AutoFilter 2, "〇" .AutoFilter 30, TargetName .Offset(4).Copy End With wsTarget.Range("A4").PasteSpecial xlPasteValues a = "完了" End If
c.Offset(, 2).Value = a set wsTarget = Nothing Next
wbBase.Close End Sub
(まっつわん) 2023/01/27(金) 14:01:01
■1
>対象シートがない場合、未完了とセルに入力したいです。
"対象シート"とは、どのブックのどのシートなのですか?
(どのように判定すればいいのですか)
(後に出てくる"配信用シート”のことですか?)
■2
>対象シートがあった場合、一度は完了と記入されますが、その後未完了と上書きされてしまい、
>C列すべて未完了と記入されてしまいます。
イメージする処理がわかりませんが、一旦完了となったらそこで処理終わりでいいなら以下のようにすればよくないですか?
.Cells(i, "C").Value = "完了" ↓ .Cells(i, "C").Value = "完了" Exit For
■3
細かい話ですが、以下でもよいかとおもいます。(「wbList」の出番がそこしかないので)
Set wbList = Workbooks.Open(Path01) Set wsList = wbList.Worksheets("※編集禁止※ALL(数式あり)") 〜 wbList.Close SaveChanges:=False
↓
Set wsList = Workbooks.Open(Path01).Worksheets("※編集禁止※ALL(数式あり)") 〜 wbList.Parent.Close SaveChanges:=False
■4
好みの問題でしょうが↓だとブックを指定しなかった場合コケますよね。
なのでブックを指定しなかったら処理を中止するようにされたらどうでしょうか?
Path01 = Application.GetOpenFilename Set wbList = Workbooks.Open(Path01)
Path02 = Application.GetOpenFilename Set wbDel = Workbooks.Open(Path02)
■5
代理店マスタを元に、配信用シートを特定
ループ処理で見ていくのも間違いではないですが↓のような方法もあります。
Set wsdel = Nothing 'ここで初期化 On Error Resume Next Set wsdel = wbDel.Worksheets(TargetName) 'セットに失敗すると「Nothing」のままになる On Error GoTo 0
If wsdel Is Nothing Then MsgBox TargetName & "シートがないっす" End If
■6
以下は、何を期待している処理なのでしょうか?(なにも取得してないのだから、初期値の""がイミディエイトに出力されるだけですよね)
C As String Debug.Print C
(もこな2) 2023/01/27(金) 14:37:18
>もこな2さん
はい、何も出力されませんでした。デバックの仕方が正しく理解できていないので、もう一度勉強いたします。
Sub organizingData()
Dim wbList As Workbook, wbDel As Workbook, wbThis As Workbook
Dim ws As Worksheet, wsList As Worksheet, wsDel As Worksheet
Dim Path01 As String, Path02 As String, targetName As String
Dim LastRow As Long, i As Long
Set wbThis = ThisWorkbook
'Ph.G対象者リストを開く
Set wbList = Workbooks.Open(wbThis.Worksheets("VBA始動").Cells(5, "D").Value)
Set wsList = wbList.Worksheets("※編集禁止※ALL(数式あり)")
'代理店配信シートを開く
Set wbDel = Workbooks.Open(wbThis.Worksheets("VBA始動").Cells(7, "D").Value)
'代理店マスタを元に、配信用シートを特定し、Ph.G対象者リストからコピー&ペースト
Set ws = wbThis.Worksheets("代理店マスタ")
LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
'マスタシートのB列を2行目からループ処理
With ws
.Range(.Range("H2"), .Cells(Rows.Count, "H").End(xlUp)).ClearContents End With For i = 2 To LastRow '対象者をマスターシートから変数に入れる targetName = ws.Cells(i, "B").Value 'wsDELに対象者のシートがあるかチェックし、シートがあれば処理を続ける 'wbDel.Activate If Evaluate("ISREF(" & targetName & "!A1)") = True Then Set wsDel = wbDel.Worksheets(targetName) wsDel.Range("A4:E" & wsDel.Cells(Rows.Count, "E").End(xlUp).Row).ClearContents 'フィルター結果のコピー With wsList With .Range("A1") .AutoFilter 2, "〇" .AutoFilter 30, targetName End With .Range("J5:N" & .Cells(Rows.Count, "N").End(xlUp).Row).Copy End With 'wsDelに結果を書き込み wsDel.Range("A4").PasteSpecial xlPasteValues Application.CutCopyMode = False 'マスターに結果を入力 ws.Cells(i, "H").Value = "完了" Else ws.Cells(i, "H").Value = "未完了" End If Next i
Application.ScreenUpdating = True
'ブックを閉じる
Application.DisplayAlerts = False
wbList.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
(トリちゃん) 2023/02/02(木) 08:49:40
Sub 整理() Dim wbDel As Workbook Dim 対象者リストSH As Worksheet, 代理店配信SH As Worksheet, 代理店マスタSH As Worksheet Dim i As Long
With ThisWorkbook.Worksheets("VBA始動") Set 対象者リストSH = Workbooks.Open(.Range("D5").Value).Worksheets("※編集禁止※ALL(数式あり)") Set wbDel = Workbooks.Open(.Range("D7").Value) End With
With ThisWorkbook.Worksheets("代理店マスタ") .Range("H2", .Cells(.Rows.Count, "H").End(xlUp)).ClearContents
For i = 2 To .Cells(Rows.Count, "B").End(xlUp).Row On Error Resume Next Set 代理店配信SH = Nothing Set 代理店配信SH = wbDel.Worksheets(Cells(i, "B").Value) On Error GoTo 0
If 代理店配信SH Is Nothing Then .Cells(i, "H").Value = "未完了" Else 対象者リストSH.AutoFilterMode = False 'オートフィルタを一旦解除 対象者リストSH.Range("A1").AutoFilter 2, "〇" 対象者リストSH.Range("A1").AutoFilter 30, .Cells(i, "B").Value 対象者リストSH.Range("J5", 対象者リストSH.Cells(対象者リストSH.Rows.Count, "N").End(xlUp)).Copy
代理店配信SH.Range("A4").PasteSpecial xlPasteValues
.Cells(i, "H").Value = "完了" End If Next i End With
Application.DisplayAlerts = False 対象者リストSH.Parent.Close SaveChanges:=False Application.DisplayAlerts = True End Sub
余計なお世話かもしれませんが、せっかく更新した↓も保存するようにされたらどうでしょうか?
Workbooks.Open(ThisWorkbook.Worksheets("VBA始動").Range("D7").Value)
(もこな2) 2023/02/02(木) 16:07:27
すんませんね、整頓されてなくて。 (稲葉) 2023/02/02(木) 16:12:30
>>整理するとこんな感じですよね
↑は「(トリちゃん) 2023/02/02(木) 08:49:40」に提示されたものを見ての話なので、稲葉さんのコードに対してではないです。
ちなみに、トピ主不採用orレスなしでしたが、コードを拝見して流れが大体わかったので 私の好みで「■1」「■3」「■5」のエッセンスを組み込んでみました。
(もこな2) 2023/02/02(木) 20:38:57
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.