Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
データをひとつのセルにまとめて、名札をつくりたい
投稿日時: 18/07/06 23:28:55
投稿者: all-the-time

よろしくお願いします。
 
会社で注文のあった商品の名札を作っています。
今は関数を使っていますが、
商品数が増えたり、注文する人が増えたりして
対応を難しくなってきました。
マクロをつかって処理をしたいのですが、
どのようにしていいかわかりません。
教えていただけないでしょうか。
 
シート1には名札リストがあります。
 
名前 |1商品|1色|1サイズ|1数量|2商品 | 2色 |2サイズ|2数量|
Aさま りんご 赤  大   2個  みかん オレンジ  小   3個
Bさま ぶどう 紫  小   1房  りんご 赤     中   2個  
 
シート2に名札シートがあります。
ひとつのセルに↓このように入るようにしています。
----------------------------
    Aさま       
 
 りんご 赤 大/2個 
みかん オレンジ 小/3個
 
----------------------------
 
 
名札シートのa1に名札リストの2行目のデータ
a2に3行目
a3に4行目
・・・
と続けていてA4の紙に3列×8行の名札をつくれるようにしています。
 
関数は↓です。
='名札リスト'!$A2&CHAR(10)&CHAR(10)&'名札リスト'!$B2&" "&'名札リスト'!$C2&" "&'名札リスト'!$D2&"/"&'名札リスト'!$E2&CHAR(10)&'名札リスト'!$F2&" "&'名札リスト'!$G2&" "&'名札リスト'!$H2&"/"&'名札リスト'!$I2&CHAR(10)&'名札リスト'!$J2&" "&'名札リスト'!$K2
 
今までだいたい一人2品くらいだったので出来ていたのですが、
人によっては4品くらいになったり、
注文してくれる人も多くなって
その度に修正するのが大変になってきましたので
マクロで解決したいです。
 
出来れば縦に並べているデータを下のように横に並べていきたいです。
 | a | b | c |
1| 2行目| 3行目 | 4行目 |
2| 5行目| 6行目 | 7行目 |
3| 8行目|・・・
 
よろしくお願いします。

回答
投稿日時: 18/07/07 10:42:28
投稿者: WinArrow
投稿者のウェブサイトに移動

ロジックとしては、↓のコードが参考になると思いますが、
 
ワープロ的なシートをマクロで対応する場合、
かなりの試行錯誤が必要と思います。
それは、数式で対応しても同じですが・・・
 
参考コード
Option Explicit
 
Dim data As String
Dim RX As Long, CX As Long
Dim Sht1 As Worksheet, sht2 As Worksheet
 
Sub test1()
    Set Sht1 = Sheets(1)
    Set sht2 = Sheets(2)
     
    With Sht1
        For RX = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            Call test2
            sht2.Range("A1").Value = data 'セル位置は固定になっています。
        Next
    End With
End Sub
 
Sub test2()
    With Sht1
        data = .Cells(RX, "A").Value & vbLf
        Call test3
    End With
 
End Sub
 
 
Sub test3()
    With Sht1
        For CX = 2 To .Cells(RX, .Columns.Count).End(xlToLeft).Column Step 4
        data = data & vbLf & .Cells(RX, CX).Value & " " & _
                    .Cells(RX, CX + 1).Value & " " & _
                    .Cells(RX, CX + 2).Value & "/" & _
                    .Cells(RX, CX + 3).Value
 
        Next
    End With
End Sub
 

回答
投稿日時: 18/07/07 14:10:36
投稿者: WinArrow
投稿者のウェブサイトに移動

sht2シートの格納セルを
3列に変更しました。
 
Option Explicit
  
Dim data As String
Dim RX1 As Long, CX1 As Long, RX2 As Long, cx2 As Long
Dim Sht1 As Worksheet, sht2 As Worksheet
  
Sub test1()
    Set Sht1 = Sheets(1)
    Set sht2 = Sheets(2)
      
    With Sht1
        For RX1 = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            Call test2
            GoSub sht2set
       Next
    End With
    Exit Sub
 
sht2set:
    With sht2
        With .Cells(.Rows.Count, "A").End(xlUp)
            If .Offset(, 0).Value = "" Then
                .Offset(, 0).Value = data
            ElseIf .Offset(, 1).Value = "" Then
                .Offset(, 1).Value = data
            ElseIf .Offset(, 2).Value = "" Then
                .Offset(, 2).Value = data
            Else
                .Offset(1).Value = data
            End If
        End With
    End With
    Return
 
End Sub
  
Sub test2()
    With Sht1
        data = .Cells(RX1, "A").Value & vbLf
        Call test3
    End With
  
End Sub
  
  
Sub test3()
    With Sht1
        For CX1 = 2 To .Cells(RX1, .Columns.Count).End(xlToLeft).Column Step 4
        data = data & vbLf & .Cells(RX1, CX1).Value & " " & _
                    .Cells(RX1, CX1 + 1).Value & " " & _
                    .Cells(RX1, CX1 + 2).Value & "/" & _
                    .Cells(RX1, CX1 + 3).Value
  
        Next
    End With
End Sub
  
 

投稿日時: 18/07/07 14:11:41
投稿者: all-the-time

WinaArrowさま
 
返信ありがとうございます。
自宅にエクセルがなく、
グーグルのスプレッドシートで試そうかと思ってたんですが、
どうやって貼り付けていいかわかりませんでした。。
 
月曜日に会社にいって試してみようと思います。
 
確認なのですが、
いただいたものは数式のところがサブの2と3のところで、
その結果がシート2のa1に表示するようになっているのですよね?
 
あとはdateをシート2のセルに順番に貼り付けていけばいいってことで
あってますでしょうか..
 
せっかく教えて頂いたのに、動かせる環境じゃないのがもどかしいです。
でもお陰様で出来そうな気がします。
ありがとうございます。
 
月曜日またお返事させてください。
どうぞよろしくお願いします。

投稿日時: 18/07/07 14:18:46
投稿者: all-the-time

WinArrowさま
 
シート2の貼り付けのところまで考えて頂きありがとうございます!
 
オフセットを使うっていう発想がなくって
なるほど!!って衝撃を受けました。
 
ありがとうございます!
 
月曜日がこんなにも待ち遠しい土曜日ってありません!
 
本当にありがとうございました。

回答
投稿日時: 18/07/07 16:37:21
投稿者: WinArrow
投稿者のウェブサイトに移動

sht2シートの行、列を変数化するつもりで
RX2、CX2という変数を用意しましたが、
結果的には不要でしたので、
目障りならば、消してください。
 

回答
投稿日時: 18/07/07 16:42:40
投稿者: simple

関数式の最後にある
&'名札リスト'!$J2&" "&'名札リスト'!$K2
の意図が不明でしたので確認するコメントをしたのですが、
先にWinArrowさんのコメントがあることに気づいたこともあり、
私のコメントは消しました。
 
そのとき手元にコードを作成してありましたので、折角ですので
参考として提示しておきます。(概ね私の自己満足のためです。)
 

Sub test()
    Dim wsL As Worksheet
    Dim ws  As Worksheet
    Dim k As Long
    Dim r As Long
    Dim c As Long
    Dim s As String
    Dim j As Long

    Set wsL = Worksheets("名札リスト")
    Set ws = Worksheets("名札")
    For k = 2 To wsL.Cells(ws.Rows.Count, 1).End(xlUp).Row

        'k行目のデータをもとに名札用文字列を作成
        s = wsL.Cells(k, 1) & vbLf & vbLf
        For j = 2 To wsL.Cells(k, wsL.Columns.Count).End(xlToLeft).Column Step 4
            s = s & wsL.Cells(k, j) & " " & wsL.Cells(k, j + 1) & " " _
                & wsL.Cells(k, j + 2) & "/" & wsL.Cells(k, j + 3) & vbLf
        Next
        's = Left(s, Len(s) - 1) ' 最後のvbLfは不要?(ただし、少し空けたほうがよいかも)

        'その書込先の 行番号rと列番号cを、名札リストの行番号kから作成
        r = (k - 2) \ 3 + 1     '3で割った商
        c = (k - 2) Mod 3 + 1   '3で割った余り

        '書き込む
        ws.Cells(r, c).Value = s
    Next
End Sub
(簡明化の観点からあえてValueプロパティを省略しているところがあります。
  突っ込みは無しでお願いします。)
   
なお、氏名だけはフォントや大きさを変えるとかの追加機能は、
そちらで適当に修正してください。
マクロ記録をとれば材料はわかります。

回答
投稿日時: 18/07/07 17:51:53
投稿者: WinArrow
投稿者のウェブサイトに移動

試行錯誤の話
 
>A4の紙に3列×8行の名札をつくれるようにしています
 
ラベル印刷で、
大きな障壁になるのが、余白と文字の桁数です。
特に、Excelは、印刷の文字列マッピング機能は、Wordのような細かい配慮がありません。
セルに「折り返し」設定すると、その現象が顕著に現れます。
 
例えば、
思わぬところで改行される・・・結果として、最終行が、印刷されないことがある。
 
余白=0を設定しても、余白無市にはできない・・・各ラベルで文字位置が異なる。
 
WORDでラベルを使って、余白なしでデザインする
という方法も検討されたら、如何でしょう?

投稿日時: 18/07/08 10:34:05
投稿者: all-the-time

>WinArrowさま
RX2、CX2という変数のところは消しても大丈夫なのですね。
ありがとうございます。
 
>simpleさま
関数はこのコメントに書き込む際、
コピペミスしていたようです。
失礼いたしました。
マクロもありがとうございました。
配置いていくところで商と余りをだすやり方も
面白いと思いました。
色んなやり方があるのですね。
 
氏名のフォントサイズを変えると分かりやすいですね!
そのようにしてみます。
 
>WinArrowさま
確かにワードの方が文字の細かい設定が出来ますね。
エクセルで書類をつくっていると
印刷した後に文字が切れていることに気付くことが多いです。
 
ワードで印刷できたら、いいなと思います。
ですが、ワードとエクセルの連携のサイトをみていると
私にはハードルが高そうです。。
 
家のPCにワードエクセルがあれば、
すぐにでも試してみたいところですが、
出来ないのが残念です。。

回答
投稿日時: 18/07/09 08:03:36
投稿者: WinArrow
投稿者のウェブサイトに移動

Excel→ Word連携の件
 
Wordでラベルをデザインした場合、
ラベルは、Wordの表に当たります。
表のセルに順次Excel側のデータを取り込んでいくには、
差込印刷という機能を使うと便利です。
 
その場合、Excel側データを3列ではなく、1列にする必要があります。
但し、「名前」のフォントサイズを変更する場合は、
「名前」列をA列
その他の部分をB列に
配置します。
 
書式は、全てWord側で指定します。
 
大雑把ですが、こんな方法で検討してみてください。
 
 

投稿日時: 18/07/09 20:57:39
投稿者: all-the-time

こんばんは!
今日いただいたマクロを会社でつかってみたところ、
思い通りにうまくいきました。
ありがとうございました。
 
>WinArrowさま
差し込み印刷の場合は1行、
名前部分のフォントを変える場合は2行にすればいいのですね!
やってみたいと思います!
 
色々と教えて頂きありがとうございました。