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

『賞状をつくりたいです。』（ヨッシー）

A5判の日記の賞状を2枚縦に並べた書式をつくりました。名簿から日記の中に、1枚目にはAさん、2枚目にはBさん・・・と入れたいのですがどうすればいいでしようか。
全員分の賞状をつくるコードは、
Sub 日記作成()

    Dim r As Range
    Dim ws As Worksheet

    For Each r In Selection
        If r.Value <> "" Then
            On Error Resume Next
                Set ws = Worksheets(r.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets("日記").Copy after:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = r.Value
            End If
        End If
    Next
 End Sub

氏名欄に名前を入れる数式は、
=RIGHT(CELL("filename",V10),LEN(CELL("filename",V10))-FIND("]",CELL("filename",V10)))
です。
どこをどのように変えればいいのでしょうか。

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

 おはようございます　＾＾
何処にお名前があって
何処に転記すればよいのでしょうか（氏名欄は何処に？）
ひょっとしてシート名がお名前ですか。
selectionはどの範囲を指しているかなど
さらに詳しくご説明いただくと、多数アドバイスが有るやもしれません。
以下気が付いた点だけで済みません。
日記をたくさん作成されるようですが。
日記は一つで、そこへ名簿から名前を
(必要なら他の物も)検索転記する方がややこしく無くて
良い気がするのは私だけでしょうか。。。m(_ _)m

（隠居じーさん） 2019/07/28(日) 07:41

隠居じーさんさんありがとうございます。
「どこに名前があるのか」⇒名簿シートがあって1から22名の名前が並んでいます。
「どこに転記するのか」⇒書式シートのV10セルとV41セルに転記したいのですが、
V10セルには1番の子、V41セルには2番目の子というように転記したいです。
「Selectionの範囲」⇒名簿シートの1から22名の名前すべてです。

「検索転記」とはどういう方法でしょうか。教えていただければ勉強になります。
（ヨッシー） 2019/07/28(日) 11:37

 こんにちは　＾＾
別段深い意味など御座いませんで。。。^^;
お名前を探して所定のセルに書き出す、という意味です。
＞＞名簿シートの1から22名
って
セルでいうとどの範囲なのでしょう、例えば　Ａ1　～　Ａ２２　でせうか
でわ
m(_ _)m
（隠居じーさん） 2019/07/28(日) 12:25

横からですけど

(1)
＞「どこに転記するのか」⇒書式シートのV10セルとV41セルに転記したい

 コードは【シート】をコピーすることになってますけど、これはこれで必要なんですよね？
 Worksheets("日記").Copy after:=Worksheets(Worksheets.Count
 【Worksheets(r.Value)】じゃなくて、【書式シート】へのコピーでよいのです？

(2)
＞V10セルには1番の子、V41セルには2番目の子というように転記したいです。

 ３人目以降はどうするのですか？

(3)
転記ということだけ考えると、こんな感じになりそうにおもいます。
（コンパイルエラーにはなりませんが、実行テストはしてません）

    Sub test()
        Dim i As Long
        Dim srcSH As Worksheet: Set srcSH = Workbooks("名簿.xlsx").Worksheets("名簿")
        Dim dstSH As Worksheet: Set dstSH = ThisWorkbook.Worksheets("書式")

        For i = 1 To 22
            If i Mod 2 Then
                dstSH.Range("V10").Value = srcSH.Cells(i, "A").Value
            Else
                dstSH.Range("V41").Value = srcSH.Cells(i, "A").Value
            End If

            '3人目以降に進む前の何らかの処理

        Next i

    End Sub

 (1)と(2)を踏まえて想像すると、やりたいことは、
 　・一旦名前を書式シートへ転記してから、
 　・書式シートを自ブック（日記シートのあるブック）の末尾にコピー挿入
 　・2名ごとに繰り返し
 したい ってことなんでしょうか？

（もこな２） 2019/07/28(日) 13:40

名前シートの1から22 というのは、A1からA22に漢字氏名、B1からB22までにひらがな氏名があります。漢字バージョンの日記賞状と
ひらがなバージョンの日記賞状をつくりたいです。

もこなさん、ありがとうございます。
もこなさんの指摘されたことをやりたいのです。
A5判の賞状1枚ずつ作るのは、最初のコードでできるのですが、A5判の賞状を2枚、つまりA4判1枚に2名分の賞状を作り、印刷していきたいです。だから、2名ごとの繰り返しになります。
（ヨッシー） 2019/07/28(日) 14:47

 こんにちは　＾＾　なにかの足しにでも。。。　m(_ _)m
Option Explicit
Sub OneInstance()
    Dim Ws As Worksheet
    Dim i As Long
    Dim j As Long
    Dim Buf As Variant
    Dim Buf2 As Variant
    Dim Buffer As Variant
    Set Ws = Worksheets("書式")
    Ws.Range("V10,V41") = ""
    With Worksheets("名簿")
        Buf = Intersect(.Cells(1).CurrentRegion, .Range("A:A"))
        Buf2 = Intersect(.Cells(1).CurrentRegion, .Range("B:B"))
        Buffer = Array(Buf, Buf2)
        For i = 0 To UBound(Buffer)
            For j = LBound(Buffer(i), 1) To UBound(Buffer(i), 1) Step 2
                Ws.Range("V10") = Buffer(i)(j, 1)
                If j + 1 > UBound(Buffer(i), 1) Then
                    Ws.PrintPreview
                    Exit For
                End If
                Ws.Range("V41") = Buffer(i)(j + 1, 1)
                Ws.PrintPreview
                Ws.Range("V10,V41") = ""
            Next
        Next
    End With
    Set Ws = Nothing
    Erase Buf, Buf2, Buffer
End Sub
（隠居じーさん） 2019/07/28(日) 15:30

＞もこなさんの指摘されたことをやりたいのです。

であれば、提示したものを改造すればできそうな気が・・・
どこがわからないですか？

（もこな２） 2019/07/28(日) 16:19

隠居じーさんさん、ありがとうございます。
漢字バージョンとひらがなバージョンの両方が印刷プレビューされました。
2点お願いがあります。
1点目ですが、名簿シートのA列目に漢字氏名、B列にひらがな氏名があります。漢字氏名を選択したなら漢字バージョンの賞状だけ、ひらがな氏名を選択したならひらがなバージョンの賞状だけできるようにはならないですか。
2点目ですが、印刷プレビューではなく、書式シートの後にすべての賞状が順番にできるようにはならないですか。できた賞状に個人ごとに手を加えたいことがあるので、賞状シートがあれば助かります。
すいませんが、よろしくお願いします。
（ヨッシー） 2019/07/28(日) 17:50

こんばんは　＾＾
＞＞書式シートの後にすべての賞状が順番にできるようにはならないですか
え～と。なにか賞状の文面を個人ごとに変えられるのでしょうか。
それでしたら名前の横に（Ｃ列）に文面を入力して
書式シートの何処に（セル番地を）それを表示させるのかを教えて下さい。
マージセルがあるならその情報もお願いします。
↑と違っていましたら、さらに詳細のご説明をお願いします。
でわ　←　出来るかどうか解りませんが。。。作ってみます。。。
他の回答者さまから、回答がありましたら、私の案はゴミ箱にでも
A(◎_◎;)。。。m(_ _)m

（隠居じーさん） 2019/07/28(日) 18:15

どうもやりたいことは、差し込み印刷ならぬ差し込みシート複製っぽい。
ただ、どこがわからないのかわからないし、どうもただの作業依頼のようにも思えてきました。

質問である場合は、具体的にどのようにしたら思う通りの結果でなくなってしまったのかなどをご説明いただくとアドバイスできることがあるかもしれません。

そうでなくて、ただの発注なら私は降ります。
（やる気になってる回答者さんの邪魔をするのも悪いですし・・）

（もこな２） 2019/07/28(日) 18:32

＞＞やる気になってる回答者さんの邪魔をするのも悪いですし・・
私の事でしたらぜんぜん悪くないですよ。。。(^^)
どんどん、回答してあげて下さい。　m(_ _)m

（隠居じーさん） 2019/07/28(日) 20:44

 シート名　名簿
       A       B              C                             
   1  名前A   なまええ       最初の人です                  
   2  名前B   なまえび       よくできました                
   3  名前C   なまえし       もうすこしがんばりましょう    
   4  名前D   なまえで       数学よかったです              
   5  名前E   なまえい       あああ                        
   6  名前F   なまええふ     いいい                        
   7  名前G   なまえじ       ううう                        
   8  名前H   なまええっち   ととと                        
   9  名前I   なまえあい     いえいえ                      
  10  名前J   なまえじぇ     とてもとても                  
  11  名前K   なまえけ       よいよい                      
  12  名前L   なまええる     わるくない                    
  13  名前M   なまええむ     とてもいい                    
  14  名前N   なまええぬ     なかなかいける                
  15  名前O   なまえお       とてもいいかも                
  16  名前P   なまえぴ       ぐぐぐ                        
  17  名前Q   なまえきゅ     げ                            
  18  名前R   なまえある     いや～                        
  19  名前S   なまええす     でわでわ                      
  20  名前T   なまえて       さすがさすが                  
  21  名前U   なまえゆ       いやいやなかなか              
  22  名前V   なまえぶい     さいこうさいこう！            
  23  DUM     ダミー         ゆうれいです

 ダサいコードになってしまいましたが。。。＾＾：           
Option Explicit
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("D10,D41,V10,V41") = ""
        For i = LBound(Buf, 1) To UBound(Buf, 1) Step 2
            .Range("D10") = Buf(i, 3)
            If MsgBV = vbYes Then .Range("V10") = Buf(i, 1)
            If MsgBV = vbNo Then .Range("V10") = Buf(i, 2)
            If i + 1 > UBound(Buf, 1) Then
                .PrintPreview
                Exit For
            End If
            If MsgBV = vbYes Then .Range("V41") = Buf(i + 1, 1)
            If MsgBV = vbNo Then .Range("V41") = Buf(i + 1, 2)
            .Range("D41") = Buf(i + 1, 3)
            .PrintPreview
            .Range("D10,D41,V10,V41") = ""
        Next
    End With
    Erase Buf
End Sub
 コード内に書込み位置の間違いがあり、修正致しました　22:23
（隠居じーさん） 2019/07/28(日) 22:11

 追記
かってに想像でシート書式のＤ１０　と　Ｄ４１　を使用しましたが
実際の書込み位置に合わせて変更してください。
でわでわ。。。m(_ _)m
（隠居じーさん） 2019/07/28(日) 22:28

隠居じーさんさん、ありがとうございました。
C列にコメントを入れるところまで考えてくださり、大変助かりました。
（ヨッシー） 2019/07/29(月) 04:39

コメント返信：

[ 一覧(最新更新順) ]

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

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