for Each の入れ子で、できそうなのですが。。。。

氏名、火～土までそれぞれの希望曜日が入ってる名簿、から　氏名、希望曜日を新しい記録用紙に
転記していきたいです、
うまく入れ子にできず、コードが2つになってしまいました。
コードが別々でもよいのですが、
その場合記録用紙作成４()の方の　インデックスを、jとしましたが、違うので動きません、
　j　をなんと表記したら、動きますか？
宜しくお願いします。
　
Sub 記録用紙作成3()
Dim 氏名 As Range
For Each 氏名 In Worksheets("名簿").Range("B2:B11,I2:I11")
Worksheets("記録用紙").Copy After:=Worksheets(Worksheets.Count)
With ActiveSheet
.Name = 氏名.Value
.Range("B1") = 氏名.Value
End With
Next 氏名
End Sub

Sub 記録用紙作成4()
Dim 曜日 As Range
Dim j As Integer
For j = 4 To 20

For Each 曜日 In Worksheets("名簿").Range("D2:H11,K2:O11")

If Worksheets("名簿").Range("D2") = "火" Then
Worksheets(j).Range("D1") = "〇"
If Worksheets("名簿").Range("E2") = "水" Then
Worksheets(j).Range("E2") = "〇"
If Worksheets("名簿").Range("F2") = "木" Then
Worksheets(j).Range("F2") = "〇"
If Worksheets("名簿").Range("G2") = "金" Then
Worksheets(j).Range("G2") = "〇"
If Worksheets("名簿").Range("H2") = "土" Then
Worksheets(j).Range("H2") = "〇"
End If
End If
End If
End If
End If
j = j + 1
Next 曜日
Next

End Sub

質問者からの補足コメント

• 

  下方に名簿をつけました。
  記録用紙のひな型をコピー、新Sheetを作成し、名簿からfor each next で先程、コピーした
  Sheetのインデックスと 、上方部へ　名簿の氏名を転記、また上方部の右並びに　火　水　木　金　土　があるので名簿と同じ曜日に〇が付くようにしたいのです。
  
  記録用紙（上方部）
  氏名　　　　　　様　　火　水　木　金　土
  
  
  名簿

  
    補足日時：2020/12/19 00:38

• 

  tatsumaru77さん、丁寧にレスありがとうございます。
  offset を使うんですね。とても参考になります。
  もう1ケ所教えていただきたいのですが、記録用紙に〇をつけるのは曜日を〇で囲みたいということです　例㋕　の様にです。
  ググって Shapes.AddShape(msoShapeOval, wx .Left, wx .Top, wx .Width, wx .Height)
  入れてみましたが、動きませんでした。
  宜しくお願いします。

    補足日時：2020/12/20 00:51

No.5 ベストアンサー 回答者： tatsumaru77 回答日時： 2020/12/19 09:33

以下のようにしてください。

Sub 記録用紙作成3のI2:I11は、画像が正しいと判断し、J2:J11としています。
Sub 記録用紙作成４のK2:O11は、画像が正しいと判断しL2:P11としています。
ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ
Sub 記録用紙作成3()
Dim 氏名 As Range
For Each 氏名 In Worksheets("名簿").Range("B2:B11,J2:J11") '変更
Worksheets("記録用紙").Copy After:=Worksheets(Worksheets.Count)
With ActiveSheet
.Name = 氏名.Value
.Range("B1") = 氏名.Value
End With
Next 氏名
End Sub

Sub 記録用紙作成4()
Dim 氏名 As Range
Dim sheet_name As String
Dim wx As Long
Dim 曜日 As Variant
曜日 = Array("火", "水", "木", "金", "土")
For Each 氏名 In Worksheets("名簿").Range("B2:B11,J2:J11")
sheet_name = 氏名.Value
For wx = 0 To 4
If 氏名.Offset(, 2 + wx).Value = 曜日(wx) Then
Worksheets(sheet_name).Range("D2").Offset(, wx).Value = "○"
End If
Next
Next 氏名
End Sub

No.13 回答者： めぐみん_ 回答日時： 2020/12/27 08:41

No.10とNo.12を足して。

Sub try_2()
Dim sh As Shape
Dim r As Range
Dim i As Integer

For Each r In Worksheets("名簿").Range("B2:B11,J2:J11")

Worksheets("記録用紙").Copy After:=Worksheets(Worksheets.Count)

Worksheets(Worksheets.Count).Name = r.Value

With Worksheets(r.Value)
.Range("B1").Value = r.Value

For i = 1 To 5

with .Range("D1:H1").Cells(1, i)

If r.Range("C1:G1").Cells(1, i).Value = .Value Then

Set sh = .Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height)
sh.Fill.Visible = msoFalse

set sh = nothing

end with

Next

End With

.range("A1").select

Next

End Sub

こんな感じでしょうかね？
検証はしてませんけど。

＞.AddShape(msoShapeOval, .Left, .Top, .Width, .Height)

ここの図形の位置及びサイズについては質問者さん側で調整して頂くしかないかと。

この回答へのお礼

有難うございます。
やってみます。

お礼日時：2021/01/04 23:40

No.12 回答者： めぐみん_ 回答日時： 2020/12/25 20:09

既に放置されているかもですが、『各記録用紙の該当セル値を"●"にする』って事なら、

Sub try()
Dim ws As Worksheet
Dim r As Range
Dim i As Integer

Set ws = Worksheets("名簿")

For Each r In ws.Range("B2:B11,J2:J11")

Worksheets("記録用紙").Copy After:=Worksheets(Worksheets.Count)

Worksheets(Worksheets.Count).Name = r.Value

With Worksheets(r.Value)
.Range("B1").Value = r.Value

For i = 1 To 5

If r.Range("C1:G1").Cells(1, i).Value <> "" Then .Range("D1:H1").Cells(1, i).Value = "●"

Next

End With

Next

Set ws = Nothing

End Sub

これでも出来ましたよ。

No.11 回答者： めぐみん_ 回答日時： 2020/12/22 11:06

既に他で解決されてるなら読み飛ばして下さい。

ストレス発散には良いかもです。

先の○をつける方法は文字は無関係でセルのサイズに合わせてます。
これを文字のサイズ（○囲い）にするのなら、図形の位置と大きさを微調整する必要があるでしょうね。
そこは情報にはない（行列のサイズや文字のサイズとか）のでこちらでは厳しいかも？

と『永遠の』初級者は思います。

No.10 回答者： めぐみん_ 回答日時： 2020/12/20 15:02

仮にですが。

・セルが真四角になるよう調整済み
・セルの値は中央に来るよう設定済み
・Ｄ２～Ｈ２の全てに〇をつける

のなら、

Dim r As Range
Dim sh As Shape

For Each r In Range("D2:H2")

With r

Set sh = ActiveSheet.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height)
sh.Fill.Visible = msoFalse

End With

Next

こんなのでも出来ます。
あとは〇を付けるかどうかの条件式が必要ですね。
⇒捕捉のコードのプロパティは何故半角スペースを挟んでいるのかがきにはなりますけど。

No.9 回答者： めぐみん_ 回答日時： 2020/12/20 09:33

記録用紙のセル番地が不明ですけど、曜日に事前に付けた〇の図形は選択するとその外側に□があると思いましたけど、これが目的のセル領域をはみ出さない事が条件。

あとは名簿でＤ～Ｈ列の値のない所については コピーした記録用紙のセル＆図形にある .Leftプロパティを用いて判別し削除するとかかな？

１０年程前に見かけた質問の回答ではそんな感じでしたね。

No.8 回答者： めぐみん_ 回答日時： 2020/12/20 08:21

検証できないので回答も意味ないのでしょけど。

○を図形でつけるのに失敗しているならそのコードを提示されてみるのも勉強です

またその数が増えることでの不具合は、古いバージョンなら経験はありました
今のが何百まで平気なのかは不明です
それとシートを振り分ける作業が一度きりなら、逆に雛形に全部付けておいてコピペ後に不要な箇所を消してしまうのも、ありなのではないかな？

と初級者は思いました
あくまで脳内妄想ですけど

No.7 回答者： tatsumaru77 回答日時： 2020/12/20 08:02

申し訳ございません。

○で囲むのは、やったことがないので判りません。どなたか識者の回答をお待ちください。

No.6 回答者： めぐみん_ 回答日時： 2020/12/19 14:12

やっぱ初級レベルとは違うんでしょうね。

私はてっきり

＞Sub 記録用紙作成3()

に全て纏められると妄想してたのですが、やっぱ妄想では検証できないので厳しいのかな？
『名簿』のＤ～Ｈ列２行目以下とかって、１行目の値を書き込んでいるかいないかであって『書き込まれている値が同じかどうかの判定』って不要なのかなって思ってましたが、ポカミス除けにチェックが必要だったんですね。

この回答へのお礼

レスありがとうございます。
名簿からの転記がメインになります。

お礼日時：2020/12/20 00:41

No.4 回答者： めぐみん_ 回答日時： 2020/12/19 09:30

『名簿』に同じ『氏名』が重複して書かれていないのなら、初級レベルでは入れ子の必要性はないと妄想しております。

結局Ｄ２～Ｈ２に『値があるか否か』で振り分け『値のあるセルを置換で”〇”としてしまう』ように脳内では思い浮かびますがその検証が・・・・。
なので、あとはベテラン回答者様に。