Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

548 / 76735

←次へ　｜　前へ→


	【81853】Re:次の列に続けて同じ処理を繰り返す方法

VBA初心者コウ - 21/6/30(水) 11:43 -


	引用なし

	パスワード

山内　様

丁寧なご回答をいただきまして誠にありがとうございます。
前任が作ったVBAを引き継いだため、どの辺りがうまく機能していないのかが
分からず…。一つ一つお答えをいただきまして大変助かります。

コードを以下に書き込み致しますので、
よろしければ見ていただけますと幸いです。
（初めから書き込めばよかったですね…。すみません。）
お付き合いいただきありがとうございます。
よろしくお願い申し上げます。

Sub 時間割作成成分()
　　ScreenUpdating = False
　　　　Range("A5:BD34").Select
　　　　Selection.ClearContents
　　Dim ws1 As Worksheet
　　Set ws1 = Worksheets("CSVデータ取得")
　　Dim ws2 As Worksheet
　　Set ws2 = Worksheets("表")
　　ws2.Cells(1, 1) = ws1.Cells(2, 11)
　　
　　Dim a As Integer
　　
　　Dim k As Integer
　　k = 5
　　
　　　　For a = 2 To 80 Step 1
　　　　If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
　　　　ws2.Cells(k, 1) = ws1.Cells(a, 6)
　　　　ws2.Cells(k + 2, 4) = ws1.Cells(a, 4)
　　　　k = k + 6
　　　　ElseIf ws1.Cells(a, 4) = "カラー" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
　　　　ws2.Cells(k, 1) = ws1.Cells(a, 6)
　　　　ws2.Cells(k + 2, 4) = ws1.Cells(a, 4)
　　　　k = k + 6
　　　　ElseIf ws2.Cells(29, 1) <> "" Then
　　　　ws2.Cells(35, 1) = ""
　　　　ws2.Cells(37, 1) = ""
　　　　End If
　　　　Next a
　　　
　　　
　　　　For a = 2 To 80 Step 1
　　　　If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "要確認" Then
　　　　ws2.Cells(k, 1) = ws1.Cells(a, 6)
　　　　ws2.Cells(k + 2, 4) = ws1.Cells(a, 4)
　　　　k = k + 6
　　　　ElseIf ws1.Cells(a, 4) = "カラー" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "要確認" Then
　　　　ws2.Cells(k, 1) = ws1.Cells(a, 6)
　　　　ws2.Cells(k + 2, 4) = ws1.Cells(a, 4)
　　　　k = k + 6
　　　　ElseIf ws2.Cells(29, 1) <> "" Then
　　　　ws2.Cells(35, 1) = ""
　　　　ws2.Cells(37, 1) = ""
　　　　End If
　　　　Next a
　　　
　　'12:00-2
　　
　　Dim h As Integer
　　h = 5
　　
　　　　For a = 2 To 80 Step 1
　　　　If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
　　　　ws2.Cells(h, 5) = ws1.Cells(a + 5, 6)
　　　　
　　　　ws2.Cells(h + 2, 8) = ws1.Cells(a + 5, 4)
　　　　h = h + 6
　　　　ElseIf ws1.Cells(a, 4) = "カラー" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
　　　　ws2.Cells(h, 5) = ws1.Cells(a + 5, 6)
　　　　ws2.Cells(h + 2, 8) = ws1.Cells(a + 5, 4)
　　　　h = h + 6
　　　　ElseIf ws2.Cells(23, 5) <> "" Then
　　　　Range("E29", "H34") = ""
　　　　End If
　　　　Next
　　
　　　　For a = 2 To 80 Step 1
　　　　If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "要確認" Then
　　　　ws2.Cells(h, 5) = ws1.Cells(a + 5, 6)
　　　　ws2.Cells(h + 2, 8) = ws1.Cells(a + 5, 4)
　　　　h = h + 6
　　　　ElseIf ws1.Cells(a, 4) = "カラー" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "要確認" Then
　　　　ws2.Cells(h, 5) = ws1.Cells(a + 5, 6)
　　　　ws2.Cells(h + 2, 8) = ws1.Cells(a + 5, 4)
　　　　h = h + 6
　　　　ElseIf ws2.Cells(23, 5) <> "" Then
　　　　Range("E29", "H34") = ""
　　　　End If
　　　　Next
　　
　　
　　　　For a = 2 To 80 Step 1
　　　　If ws2.Cells(5, 1) = "" Or ws2.Cells(11, 1) = "" Or ws2.Cells(17, 1) = "" Or ws2.Cells(23, 1) = "" _
　　　　Or ws2.Cells(29, 1) = "" Then
　　　　Range("E5", "H34") = ""
　　　　ElseIf ws1.Cells(a, 12) <> "1200" And ws1.Cells(a + 5, 4) = "カラー" Then
　　　　ws2.Cells(h + 2, 5) = ""
　　　　ws2.Cells(h, 8) = ""
　　　　h = h + 6
　　　　ElseIf ws1.Cells(a, 12) <> "1200" And ws1.Cells(a + 5, 4) = "トリートメント" Then
　　　　ws2.Cells(h + 2, 5) = ""
　　　　ws2.Cells(h, 8) = ""
　　　　h = h + 6
　　　
　　　　End If
　　　　Next
　　　　

・・・という風になっております。
12：00・13：30・15：00と続くため、コードはコピー＆ペーストで時間のみを入れ替えています。
ws1.Cells(a, 6)にお名前
ws1.Cells(a, 4)にカット・カラー・トリートメントのどの予約なのかが入ります。

大変申し訳ございませんが、おかしな箇所がありましたらご指摘下さいますと幸いです。よろしくお願い申し上げます。

13 hits

▼

【81841】次の列に続けて同じ処理を繰り返す方法 VBA初心者コウ 21/6/22(火) 19:19