[[20190813114703]]　『「賞状をつくりたいです。」[ヨッシー]　について』（ヨッシー）　ページの最後に飛ぶ

『「賞状をつくりたいです。」[ヨッシー]　について』（ヨッシー）

投稿
[[20190728054346]] 『賞状をつくりたいです。』（ヨッシー）　
について...

隠居じーさんさん、もう一度質問させてください。
教えていただいたコードで賞状をプレビューさせて作ることができました。
それで、プレビューではなくて、次のようにコードを少し変更して、２人ずつの賞状をシートとして次々とできるようにしてみました。
Sub OneInstance()

    Dim i As Long
    Dim Buf As Variant
    Dim MsgBV As Variant
    MsgBV = MsgBox("漢字＝ＯＫ　ひらがな＝ＮＯ", vbYesNo)
    With Worksheets("家庭学習名簿")
        Buf = .Cells(1).CurrentRegion
    End With
    With Worksheets("家庭学習")
        .Range("I14,AW14,J11,AX11") = ""
        For i = LBound(Buf, 1) To UBound(Buf, 1) Step 2
            .Range("I14") = Buf(i, 3)
            If MsgBV = vbYes Then .Range("J11") = Buf(i, 1)
            If MsgBV = vbNo Then .Range("J11") = Buf(i, 2)
            If i + 1 > UBound(Buf, 1) Then
                Worksheets("家庭学習").Copy after:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = Buf(i, 1).Value

                Exit For
            End If
            If MsgBV = vbYes Then .Range("AX11") = Buf(i + 1, 1)
            If MsgBV = vbNo Then .Range("AX11") = Buf(i + 1, 2)
            .Range("AW14") = Buf(i + 1, 3)
            Worksheets("家庭学習").Copy after:=Worksheets(Worksheets.Count)

            .Range("I14,AW14,J11,AX11") = ""
        Next
    End With
    Erase Buf
End Sub

まず、これで正しいですか。それと、シートが人数分できたのですが、シート名を「名前A・名前B」というようにするには、どう直したらいいでしょうか。

＜使用 Excel：Office365、使用 OS：unknown ＞

 こんにちは　＾＾
賞状を保存されるのですね。。。
まず、ご提示のコードはエラーで動きません。
Worksheets(Worksheets.Count).Name = Buf(i, 1).Value
Buf(i,1)はレンジオブジェクトではありませんので、後ろに.Valueを
つけられても、意味はないかと、それを修正して、最後だけでなく
途中も名前を付ければよいですよ。ちょっといまたてこんでまして
のちほどアップしておきます。m(_ _)m
（隠居じーさん） 2019/08/13(火) 12:58

 こんにちは　＾＾　お待たせいたしました。修正してみました。
わたしが作ったコードでも、リンクは設定した方が良いですが、
名前指定で、質問はされないほうがお得ですよ。。。

 ↑理由。。。わたしが死んだふりしてても,ご親切な、どなたかが、(￣▽￣)
回答して下さる可能性が多大です　←　多分　＾＾；；；。。。。m(_ _)m

 Option Explicit
Sub OneInstanceYoshiSan()
    Dim i As Long
    Dim Buf As Variant
    Dim MsgBV As Variant
    MsgBV = MsgBox("漢字＝ＯＫ　ひらがな＝ＮＯ", vbYesNo)
    With Worksheets("家庭学習名簿")
        Buf = .Cells(1).CurrentRegion
    End With
    With Worksheets("家庭学習")
        .Range("I14,AW14,J11,AX11") = ""
        For i = LBound(Buf, 1) To UBound(Buf, 1) Step 2
            .Range("I14") = Buf(i, 3)
            If MsgBV = vbYes Then .Range("J11") = Buf(i, 1)
            If MsgBV = vbNo Then .Range("J11") = Buf(i, 2)
            If i + 1 > UBound(Buf, 1) Then
                Worksheets("家庭学習").Copy after:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = Buf(i, 1)
                Exit For
            End If
            If MsgBV = vbYes Then .Range("AX11") = Buf(i + 1, 1)
            If MsgBV = vbNo Then .Range("AX11") = Buf(i + 1, 2)
            .Range("AW14") = Buf(i + 1, 3)
            Worksheets("家庭学習").Copy after:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = Buf(i, 1) & "・" & Buf(i + 1, 1)
            .Range("I14,AW14,J11,AX11") = ""
        Next
    End With
    Erase Buf
End Sub
（隠居じーさん） 2019/08/13(火) 14:00

隠居じーさんさん、名前を指定してすいませんでした。
直していただきありがとうございます。おかげさまでスッキリ解決しました。
また、このコードでいろいろ勉強になりました。まだ知らないことだらけなので
教えていただくことがあると思います。その際は、よろしくお願いします。

（ヨッシー） 2019/08/13(火) 15:55

解決してるっぽいのでよもやま話で。

■１
＞まず、これで正しいですか。
正しいかどうか（ちゃんと動くか）の検証は、デバッグ作業そのものですから、本来ご自身で行うべきだとおもいます。

■2
値を書き換えてからコピーするより、
ひな形をコピーしてから値を書き込むと考えた方が、いちいち値を消さなくて良い分ちょこっとだけ高速だったりするような気がします。

■3
処理する人数が奇数だった場合を考えておいた方が良い気がします。

■３
配列を取り込んで処理することを否定するものではないですが、混乱してしまいそうなときは、あえてセル範囲として考えてみるのもアリかなとおもいます。

■４
踏まえた別案。

    Sub OneInstance_別案()
        Dim srcRNG As Range
        Dim i As Long
        Dim 列 As Long

        Stop 'ブレークポイントのかわり

        Set srcRNG = Worksheets("家庭学習名簿").Cells(1).CurrentRegion

        'モードを指定
        If MsgBox("漢字＝ＯＫ　ひらがな＝ＮＯ", vbYesNo) = vbYes Then
            列 = 1
        Else
            列 = 2
        End If

        'ループ処理
        For i = 1 To srcRNG.Rows.Count Step 2

            '▼【ブランクの】ひな形シートを末尾にコピー
            Worksheets("家庭学習").Copy after:=Worksheets(Worksheets.Count)

            '▼コピーして出来たシートを操作
            With Worksheets(Worksheets.Count)

                '▼一人目の転記
                .Range("J11").Value = srcRNG.Cells(i, 列).Value

                '▼二人目の転記（奇数人対策）
                If i + 1 <= srcRNG.Rows.Count Then
                    .Range("AX11").Value = srcRNG.Cells(i + 1, 列).Value
                End If

                'なんかの処理
                .Range("AW14").Value = srcRNG.Cells(i + 1, 3).Value

                '▼シート名の処理（奇数人対策）
                If .Range("AX11").Value <> "" Then
                    .Name = .Range("J11").Value & "・" & .Range("AX11").Value
                Else
                    .Name = .Range("J11").Value
                End If
            End With
        Next i

    End Sub

（もこな２） 2019/08/13(火) 17:41

もこな2さん、大変遅くなってすいません。今、コードを見たところです。
奇数人対策を全く考えていませんでした。参考にさせてもらいます。
ありがとうございました。
（ヨッシー） 2019/08/14(水) 01:37

コメント返信：

[ 一覧(最新更新順) ]

[[20190813114703]] 『「賞状をつくりたいです。」[ヨッシー] について』（ヨッシー） ページの最後に飛ぶ

[[20190813114703]]　『「賞状をつくりたいです。」[ヨッシー]　について』（ヨッシー）　ページの最後に飛ぶ