[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ラベル大量作成時に効率のいい連番の振り方』（エルもっち）
こんにちは
A4シート１枚から６枚の連番ラベルを多数作成（連番100くらいをシートカッターでカット）したいのですが、普通に上から順番に連番を印字してカットしたら１つの束にまとめるときカットしたラベルを１枚ずつ重ねていかなければなりません。
連番100なら17枚になりますが17枚重ねてカットしたとき2枚目の左上が2、3枚目の左上が3、・・・17枚目の左上が17で次は1枚目の左上から1つ下が18番、2枚目が19番・・・と縦に番号が割り振られるようにしカットしたとき1束ずつ効率よく重ねていけるようにしたいと思っているのですがどのように考えていけばいいでしょうか？
分かりにくい説明で申し訳ありませんがよろしくお願いします。
1 開始ナンバー・月日・予定台数を入力したらラベルに効率のいい連番が入力される
2 予定台数以上は連番を割り振らなくてもいい
例 1枚目
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
1枚のシートへの番号の記載は手入力でしょうか。 数式でしょうか。 マクロでしょうか。
いずれにせよ、１～100であれば、N枚目の番号が N , 51+N, 17+N, 68+N, 34+N, 85+N
となるようにすれば、良いと思います。 （QS） 2020/12/06(日) 12:43
こんなテーブルを作成して
作業列で並べ替えてはどうでしょうか。
印刷は、差し込み印刷で。
17枚というのは暗算でも可能ですよね。
A B C D 1 No 月 日 作業列 2 1 12 5 0 =MOD(A2-1,17) 3 2 12 5 1 4 3 12 5 2 5 4 12 5 3
（マナ） 2020/12/06(日) 13:51
シートへの番号割り振りは数式かマクロがいいです。
開始ナンバー・月・日・予定台数を入力したら
自動で番号が割り振られ印刷ボタンで必要枚数が
印刷されるのが理想です。
例
A B C D E F G H I J K
1 1 12.5 10 12.5 開始 月 日 台数 2 4 12.5 13 12.5 1 12 5 16 3 7 12.5 16 12.5 4 5 2 12.5 11 12.5 6 5 12.5 14 12.5 7 8 12.5 8 9 3 12.5 12 12.5 10 6 12.5 15 12.5 11 9 12.5 （エルもっち） 2020/12/06(日) 15:13
それまでのつなぎで、今日もPower Queryです
質問者さんは無視していただいて結構です
１）こんな感じで、F1:I2に、条件入力用テーブルを用意します ２）Power Quiery で、A～D列に、差し込み印刷用テーブルを出力します ３）データ変更は、差し込み印刷用テーブルを右クリックで「更新」を選択します ４）印刷は、Wordの差し込み印刷を利用します
A B C D E F G H I 1 No Month Day Sheet 開始 月 日 台数 2 3 12 5 0 3 12 5 8 3 5 12 5 0 4 7 12 5 0 5 9 12 5 0 6 0 7 0 8 4 12 5 1 9 6 12 5 1 10 8 12 5 1 11 10 12 5 1 12 1 13 1
'-----
let
ソース = Excel.CurrentWorkbook(){[Name="入力用テーブル"]}[Content],
変更された型 = Table.TransformColumnTypes(ソース,{{"開始", Int64.Type}, {"月", Int64.Type}, {"日", Int64.Type}, {"台数", Int64.Type}}),
必要台数 = 変更された型[台数]{0},
必要枚数 = Number.RoundUp(必要台数/6),
開始番号 = 変更された型[開始]{0},
追加されたカスタム = Table.AddColumn(変更された型, "カスタム", each List.Repeat({"a"},必要枚数*6)),
#"展開された カスタム" = Table.ExpandListColumn(追加されたカスタム, "カスタム"),
追加されたインデックス = Table.AddIndexColumn(#"展開された カスタム", "番号", 開始番号, 1, Int64.Type),
追加されたインデックス1 = Table.AddIndexColumn(追加されたインデックス, "インデックス", 0, 1, Int64.Type),
挿入された剰余 = Table.AddColumn(追加されたインデックス1, "Sheet", each Number.Mod([インデックス], 必要枚数), type number),
追加された条件列 = Table.AddColumn(挿入された剰余, "No", each if [インデックス] < 必要台数 then [番号] else null),
追加された条件列1 = Table.AddColumn(追加された条件列, "Month", each if [インデックス] < 必要台数 then [月] else null),
追加された条件列2 = Table.AddColumn(追加された条件列1, "Day", each if [インデックス] < 必要台数 then [日] else null),
並べ替えられた行 = Table.Sort(追加された条件列2,{{"Sheet", Order.Ascending}, {"インデックス", Order.Ascending}}),
削除された他の列 = Table.SelectColumns(並べ替えられた行,{"No", "Month", "Day", "Sheet"})
in
削除された他の列
'----- 今回気づいたこと： 「列の削除」と「列の並べ替え」は同時にできる
（マナ） 2020/12/06(日) 20:58
取り合えずのサンプルですが、なんか違ってそう・・・。 > A B C D > 1 1 12.5 10 12.5 > 2 4 12.5 13 12.5 > 3 7 12.5 16 12.5
の意味が分かっていません。
Sub Print6()
Dim cWS As Worksheet
Set cWS = ActiveSheet
Dim pWS As Worksheet
Set pWS = Worksheets("印刷") '// 同じシートなら ActiveSheet に
Dim n
n = Int((cWS.Range("J2").Value + 5) / 6)
Dim s
s = cWS.Range("G2").Value
Dim i
For i = 0 To n - 1
pWS.Range("A1").Value = s + i
pWS.Range("A5").Value = s + n + i
pWS.Range("A9").Value = s + 2 * n + i
pWS.Range("C1").Value = s + 3 * n + i
pWS.Range("C5").Value = s + 4 * n + i
pWS.Range("C9").Value = s + 5 * n + i
pWS.PrintPreview '// プレビュー
'// pWS.PrintOut '// 印刷
Next
End Sub
（QS） 2020/12/06(日) 23:00
こんにちは ＾＾ あまり自信はありませんが。。。
きっと、たくさん、無駄な事してると思います。A^^:
ご考察の足しにでも。← ならないかも。。。(*^^*)
左端のシートの情報は消去され、確認用のログが出力さ
れます。お試しの際は新規ブックをお勧めいたします。
Option Explicit
Sub OneInstance02()
Dim ws1 As Worksheet
Dim i As Long
Dim j As Long
Dim k As Long
Dim y As Long
Dim x As Long
Dim zStartNum As Long
Dim zM As Long
Dim zD As Long
Dim pCnt As Long
Dim iMax As Long
Dim v() As Variant
Dim tmp() As Variant
Dim fg As Boolean
zStartNum = 101
zM = 12
zD = 5
iMax = 100
If iMax < 1 Then
Exit Sub
End If
Set ws1 = Worksheets(1)
pCnt = iMax \ 6
pCnt = IIf(iMax - pCnt * 6 > 0, pCnt + 1, pCnt)
ReDim tmp(1 To 3, 1 To 2)
ReDim v(1 To pCnt)
x = 1: y = 1
For i = 1 To pCnt
For y = 1 To 3
If y = 1 Then
tmp(y, 1) = i
Else
If tmp(y - 1, 1) + pCnt <= iMax Then
tmp(y, 1) = tmp(y - 1, 1) + pCnt
Else
fg = True
Exit For
End If
End If
Next
If Not fg Then
For y = 1 To 3
If y = 1 Then
If tmp(3, 1) + pCnt > iMax Then Exit For
tmp(y, 2) = tmp(3, 1) + pCnt
Else
If tmp(y - 1, 2) + pCnt <= iMax Then
tmp(y, 2) = tmp(y - 1, 2) + pCnt
Else
Exit For
End If
End If
Next
End If
v(i) = tmp
If fg Then Exit For
ReDim tmp(1 To 3, 1 To 2)
fg = False
Next
zTmpSheetDelete
zLogWriteOut ws1, v
With ws1
.Copy after:=Worksheets(Worksheets.Count)
End With
ActiveSheet.Name = "TmpXXX"
With Worksheets("TmpXXX")
.Cells.Delete
y = 2: x = 0
For i = 1 To UBound(v)
For j = 1 To UBound(v(i), 1)
For k = 1 To UBound(v(i), 2)
If v(i)(j, k) <> "" Then
.Cells(y, x + k) = v(i)(j, k) + (zStartNum - 1)
Else
.Cells(y, x + k) = v(i)(j, k)
End If
.Cells(y, x + k).Offset(, 2) = zM & "." & zD
x = x + 4
Next
y = y + 12
x = 0
Next
.PrintPreview
y = 2
Next
.Activate
End With
Set ws1 = Nothing
Erase v, tmp
End Sub
Private Sub zLogWriteOut(ByVal zWs1 As Worksheet, ByRef v() As Variant)
Dim i As Long
Dim y As Long
Dim x As Long
With zWs1
.UsedRange.Delete
y = 2: x = 2
For i = 1 To UBound(v)
.Cells(y, x).Resize(3, 2) = v(i)
y = y + 4
If y > 20 Then
y = 2
x = x + 4
End If
Next
End With
End Sub
Private Sub zTmpSheetDelete()
Dim i&
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
If Worksheets(i).Name = "TmpXXX" Then
Worksheets(i).Delete
End If
Next
Application.DisplayAlerts = True
End Sub
（隠居じーさん） 2020/12/09(水) 11:06
（隠居じーさん） 2020/12/09(水) 14:02
___A____B____C____D__E__F__G______H_____I____J______K______________
1 ■ 開始 月 日 台数
2 ■ ■ 1 16
3 ■ ■
4
5
↑のようなレイアウトのときに■のところに↓の数式を設定する。※
A2セル =IF(A1+(ROUNDUP($K$2/6,0)*1)>$H$2-1+$K$2,"",A1+(ROUNDUP($K$2/6,0)*1)) A3セル =IF(A1+(ROUNDUP($K$2/6,0)*2)>$H$2-1+$K$2,"",A1+(ROUNDUP($K$2/6,0)*2)) C1セル =IF(A1+(ROUNDUP($K$2/6,0)*3)>$H$2-1+$K$2,"",A1+(ROUNDUP($K$2/6,0)*3)) C2セル =IF(A1+(ROUNDUP($K$2/6,0)*4)>$H$2-1+$K$2,"",A1+(ROUNDUP($K$2/6,0)*4)) C3セル =IF(A1+(ROUNDUP($K$2/6,0)*5)>$H$2-1+$K$2,"",A1+(ROUNDUP($K$2/6,0)*5))
以下のコードを記述して実行する
Sub さんぷる1()
Dim i As Long
With ActiveSheet
.Range("A4:C" & .Rows.Count).ClearContents
For i = 0 To WorksheetFunction.RoundUp(.Range("K2").Value / 6, 0) - 1
.Range("A1:C3").Copy .Range("A1").Offset(i * 4)
.Range("A1").Offset(i * 4).Value = i + .Range("H2").Value
Next i
End With
End Sub
ちなみに、印刷をマクロで行うなら↓のようでも良いと思います。
Sub さんぷる2()
Dim i As Long
With ActiveSheet
For i = 0 To WorksheetFunction.RoundUp(.Range("K2").Value / 6, 0) - 1
.Range("A1").Value = i + .Range("H2").Value
.PrintPreview '←運用時は「PrintOut」にする
Next i
End With
End Sub
※数式の部分はもうちょっと頑張れば単純化できそうですが思いつきませんでした。 （代替え案として、数式で""にするのではなく条件付き書式で文字色を白に変えるというのはアリかも）
以上参考まで。
（もこな２） 2020/12/17(木) 1:27
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.