Excel VBA質問箱 IV

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

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


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

617 / 76807

←次へ　｜　前へ→


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

山内 - 21/7/2(金) 17:18 -


	引用なし

	パスワード

とりあえず作ってみましたがカットやカラー、トリートメント
または予約可、要確認はどういう法則で並べていくのかよくわからないです。
A1セルが多分担当者の名前とかなんだろうと思いますが担当者によって条件が違うんでしょうか。

Sub 時間割作成成分()
　　Application.ScreenUpdating = False
　　
　　Dim ws1 As Worksheet
　　Set ws1 = Worksheets("CSVデータ取得")
　　Dim ws2 As Worksheet
　　Set ws2 = Worksheets("表")

　　Dim a As Long
　　Dim i As Long 'for行
　　Dim j As Long 'for列
　　Dim iLast As Long: iLast = 5　 '1以上
　　Dim jLast As Long
　　Dim rng As Range
　　Dim clmnplus As Long
　　
　　ws2.Range("A5:BD" & iLast * 6 + 4).ClearContents
　　ws2.Cells(1, 1) = ws1.Cells(2, 11)
　　
　　For a = 2 To 80
　　　　Select Case ws1.Cells(a, 12).Value
　　　　Case "0915" '"915"かも？
　　　　　　clmnplus = 0
　　　　Case "1000"
　　　　　　clmnplus = 8
　　　　Case "1200"
　　　　　　clmnplus = 16
　　　　Case "1300"
　　　　　　clmnplus = 31
　　　　Case "1500"
　　　　　　clmnplus = 39
　　　　Case "1600"
　　　　　　clmnplus = 47
　　　　Case Else
　　　　　　GoTo 脱出
　　　　End Select
　　　　'If (ws1.Cells(a, 4).Value = "カット" Or ws1.Cells(a, 4).Value = "カラー") _
　　　　And ws1.Cells(a, 14).Value = "予約可" Then
　　　　'よくわからないのでとりあえずコメントアウト
　　　　　　For j = 1 To 2
　　　　　　　　For i = 1 To iLast
　　　　　　　　　　Set rng = ws2.Cells(i * 6 - 1, j * 4 - 3 + clmnplus)
　　　　　　　　　　If rng.Value = "" Then
　　　　　　　　　　　　rng.Value = ws1.Cells(a, 6).Value
　　　　　　　　　　　　ws2.Cells(rng.Row + 2, rng.Column + 3).Value = ws1.Cells(a, 4).Value
　　　　　　　　　　　　GoTo 脱出
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　Next
　　　　'End If
脱出:
　　Next
　　
　　Application.ScreenUpdating = True
　　
End Sub

3 hits

▼

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