[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『表のデータと同じ番号のシートを印刷したい。』（すず）
sheetAは
Ａ B C D
1 組
2 番
3 氏
4 名
5 12
6 24
8
9 42
と、B列以降も入力されています。
5行～9行は、入力されていない場合もあります。
他に、sheet11～49がありますが、
A列から順に表にある数字と同じ名前のシートを印刷したいのです。
各シートは1ページ分しかありません。
また、各シートは全部同じ書式ですが、
A1セルに組 、C1セルに番、E1セルに氏、J1セルに名が表示されるようにしたいです。
初心者の私には解決できなくて、今のところ手作業です。
すいません。
よろしくお願いします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
こんばんは ＾＾
１．Ｂ、Ｃ、Ｄ列も組番氏名、数値[１１～４９]が入力されているのですね。
２．数値の部分だけ取得してその数値がシート名になっているシートをその
数値が有った列の組番氏名を動的に表示して印刷、と言う事でせうか？
ご返信賜ると、回答が付く率がぐんと上がるかもしれません←多分＾＾； 私は解らないかもしれませんが、気が付いた点だけであいすみません。。。m(_ _)m でわ （隠居じーさん） 2021/06/12(土) 18:00
組,番,氏,名以外の情報は、現時点では特になく、いわばフォーマットが定められているだけ、
いわば、手で記入するための紙を印刷するということでしょうか？
後で、実はこれこれのことも、といったことが無いように確認しています。
なお、数値は、その列の、空白でない最終行までの間にある、空白以外の数値が
対象になるということでいいんですか？
（γ） 2021/06/12(土) 18:11
?@ Ｂ列以降、ＡＺ列まで組番氏名が入力されています。
?A 5～9行の数値は、入力されていない場合があります。入力された数値と同じ名前のシートだけ印刷したいです。
?B 11～49シートの内容はそれぞれ決まっていて固定です。異なるのはA1セル以下に組番氏名を表示させて印刷したいです。
?C できれば、指定した組番から指定した組番まで、複数人の分を印刷したいです。
つまり、1組1番～2組5番までと入力したら
1組1番の佐藤は、13、42となっていたとしたら、13、42のシートを1組1番佐藤と名前を入れて印刷。
1組2番の鈴木が空白だったら、何も印刷しない。
・
・
・
2組5番の田中は14、23、36、49となっていたとしたら、14、23、36、49のシートを2組5番田中と名前を入れて印刷
という感じです。
わかりにくくてすいません。
宜しくお願いします。
（すず） 2021/06/13(日) 06:55
おはよ～ございます ＾＾
とりあえず sheetA 予測 表 ←想像でしかありません
相違点があれば、ご修正を。。。整理のお手伝いだけでも
m(_ _)m
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |[Q] |[R] |[S] |[T] |[U] |[V] |[W] |[X] |[Y] |[Z] |[AA] |[AB] |[AC] |[AD] |[AE] |[AF] |[AG] |[AH] |[AI] |[AJ] |[AK] |[AL] |[AM] |[AN] |[AO] |[AP] |[AQ] |[AR] |[AS] |[AT] |[AU] |[AV] |[AW] |[AX] |[AY] |[AZ]
[1]| 1| 1| 1| 1| 1| 1| 1| 1| 1| 1| 2| 2| 2| 2| 2| 2| 2| 2| 2| 2| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 3| 5| 5| 5| 5| 5| 5| 5| 5| 5| 5
[2]| 1| 2| 3| 4| 5| 6| 7| 8| 9| 10| 1| 2| 3| 4| 5| 6| 7| 8| 9| 10| 1| 2| 3| 4| 5| 6| 7| 8| 9| 10| 11| 12| 13| 14| 15| 16| 17| 18| 19| 20| 21| 22| 1| 2| 3| 4| 5| 6| 7| 8| 9| 10
[3]|LNM-C2|LNM-C3|LNM-C4|LNM-C5|LNM-C6|LNM-C7|LNM-C8|LNM-C9|LNM-C10|LNM-C11|LNM-C12|LNM-C13|LNM-C14|LNM-C15|LNM-C16|LNM-C17|LNM-C18|LNM-C19|LNM-C20|LNM-C21|LNM-C22|LNM-C23|LNM-C24|LNM-C25|LNM-C26|LNM-C27|LNM-C28|LNM-C29|LNM-C30|LNM-C31|LNM-C32|LNM-C33|LNM-C34|LNM-C35|LNM-C36|LNM-C37|LNM-C38|LNM-C39|LNM-C40|LNM-C41|LNM-C42|LNM-C43|LNM-C44|LNM-C45|LNM-C46|LNM-C47|LNM-C48|LNM-C49|LNM-C50|LNM-C51|LNM-C52|LNM-C53
[4]|FNM-D2|FNM-D3|FNM-D4|FNM-D5|FNM-D6|FNM-D7|FNM-D8|FNM-D9|FNM-D10|FNM-D11|FNM-D12|FNM-D13|FNM-D14|FNM-D15|FNM-D16|FNM-D17|FNM-D18|FNM-D19|FNM-D20|FNM-D21|FNM-D22|FNM-D23|FNM-D24|FNM-D25|FNM-D26|FNM-D27|FNM-D28|FNM-D29|FNM-D30|FNM-D31|FNM-D32|FNM-D33|FNM-D34|FNM-D35|FNM-D36|FNM-D37|FNM-D38|FNM-D39|FNM-D40|FNM-D41|FNM-D42|FNM-D43|FNM-D44|FNM-D45|FNM-D46|FNM-D47|FNM-D48|FNM-D49|FNM-D50|FNM-D51|FNM-D52|FNM-D53
[5]| | 28| 43| 26| 34| 49| 27| | 42| 22| 20| 26| 14| 38| | | 45| | 26| 27| 48| 19| | | | | 44| 21| 34| 37| 34| 25| 42| 43| | 13| 34| 28| 40| | 44| | | 13| 42| 16| | 31| | 39| | 45
[6]| 22| 37| 42| 38| 28| 45| 19| 22| | | 41| 16| | 41| 49| 26| | | 43| | 27| 27| | 30| 23| | | 39| 17| | 13| | | 24| | 11| | | 19| 18| 18| 46| 26| 42| 39| 31| | 37| 32| 43| | 42
[7]| 40| | 37| 47| | | 23| 48| 17| 22| | 30| 21| 29| 32| 27| 37| | 16| | | 18| 38| | | 23| | 17| 49| | | 25| | 11| 45| 35| | 25| 43| 29| | 38| | 17| 27| 23| 24| 17| | 47| 18|
[8]| | 20| 47| 46| | 27| 47| 13| 26| | 13| 25| 39| | | 42| 15| 45| 25| 31| | | 40| 26| 37| | 40| 31| 28| 46| | 37| | | | 43| 34| 14| 44| 37| | 47| 36| 16| | | | 40| 22| 33| 19|
[9]| 35| | 30| | 22| 14| 12| 39| 37| 36| 41| | | | 19| 36| 48| 32| | | 18| | | | 39| 40| | 38| | | 36| 20| | 31| | | 31| 32| 28| | | 25| 42| | 30| 31| | | 41| | 33| 49
（隠居じーさん） 2021/06/13(日) 10:32
組番氏名を動的に表示して印刷、ということが難しいのであれば、
ここは撤退して単にシート印刷だけでも仕方ないと思っています。
それだけでも大助かりなので。
（すず） 2021/06/13(日) 10:56
ＶＢＡでよければ、ですが。。。A^^;
エラー処理等、よく考えずに、かなりいい加減に作っていますので
ご考察時の参考程度にお止め下さいませ。m(_ _)m ←合ってるかどぉかも解りません＾＾；
なにやら横に長かったので、横置きにしていますが
ご環境にあわせ調整してくださいませ。
m(_ _)m
Option Explicit
Sub OneInstanceMain()
Dim i As Long
Dim j As Long
Dim s As Long
Dim e As Long
Dim v() As Variant
Dim sretu As Long
Dim eretu As Long
Dim kumi As Long
Dim ban As Long
Dim lNm As String
Dim fNm As String
zAcceptSe s, e
With Worksheets("SheetA")
v = .Cells(1).CurrentRegion.Value
End With
For i = 1 To UBound(v, 2)
If s = CLng(v(1, i) & v(2, i)) Then sretu = i
If e = CLng(v(1, i) & v(2, i)) Then eretu = i
Next
For i = sretu To eretu
kumi = v(1, i)
ban = v(2, i)
lNm = v(3, i)
fNm = v(4, i)
For j = 5 To 9
If v(j, i) <> "" And IsNumeric(v(j, i)) Then
With Worksheets(CStr(v(j, i)))
.Range("A1,C1,E1,J1").Clear
.Range("A1") = kumi
.Range("C1") = ban
.Range("E1") = lNm
.Range("J1") = fNm
.PageSetup.Orientation = xlLandscape
.PrintPreview
End With
End If
Next
Next
End Sub
Private Sub zAcceptSe(ByRef startnum As Long, ByRef endnum As Long)
Dim a As Variant
Dim b As Variant
a = Application.InputBox("開始する組と番を数値で入力して下さい", "開始組＆番", "11", , , , , 1)
If TypeName(a) = "Boolean" Then End
startnum = a
b = Application.InputBox("終了する組と番を数値で入力して下さい", "終了組＆番", "13", , , , , 1)
If TypeName(a) = "Boolean" Then End
endnum = b
End Sub
（隠居じーさん） 2021/06/13(日) 13:20
ありがとうございます。
（すず） 2021/06/13(日) 14:58
SheetＡ → 入力
5～9行 → 5～10行
A1、C1、E1、J1 → CF1、CJ1、CO1、CX1
データがＡ行から → Ｂ行から
なので、Ａ行→Ｂ行以外はすぐにわかったので変えて、
マクロ作成のところに貼り付けて、実行してみました。
Dimが終わった後の6行目、
For i = 1 To UBound(v, 2)
If s = CLng(v(1, i) & v(2, i)) Then sretu = i
のif文で、ということは次の文もそうなのかもしれませんが、
型が一致しません
と表示が出て
ifからthenまで黄色くなって止まってしまいました。
何が起こったのでしょうか…
Ａ行→Ｂ行
にしたせいでしょうか。
すいません。
（すず） 2021/06/14(月) 07:51
おはようございます ＾＾ １．実際の【組】と【番】どちらか、若しくは両方が数値ではないとか？ ２．参照するセルの行、列どちらかが違うため１．が発生 とかが 考えられますです。。。？ ＾＾； m(__)m （隠居じーさん） 2021/06/14(月) 08:12
CLng()を剥がすとどぉなりますでせう＾＾； ↓
If s = v(1, i) & v(2, i) Then sretu = i （隠居じーさん） 2021/06/14(月) 08:17
あ！。。。すみません、すみません 外すと完璧、型ちがいです。m(__)m
外してから、s,eの型宣言をバリアント型に変えてみて下さいませ。 m(__)m （隠居じーさん） 2021/06/14(月) 08:51
＞＞Ａ行→Ｂ行 これつて 列の間違いですよね＾＾； 変わっていないのでは？ 変更後のコードもアップしてみて下さいませ。m(__)m （隠居じーさん） 2021/06/14(月) 09:05
コードは、
Option Explicit
Sub OneInstanceMain()
Dim i As Long
Dim j As Long
Dim s As Long
Dim e As Long
Dim v() As Variant
Dim sretu As Long
Dim eretu As Long
Dim kumi As Long
Dim ban As Long
Dim lNm As String
Dim fNm As String
zAcceptSe s, e
With Worksheets("入力")
v = .Cells(1).CurrentRegion.Value
End With
For i = 1 To UBound(v, 2)
If s = CLng(v(1, i) & v(2, i)) Then sretu = i
If e = CLng(v(1, i) & v(2, i)) Then eretu = i
Next
For i = sretu To eretu
kumi = v(1, i)
ban = v(2, i)
lNm = v(3, i)
fNm = v(4, i)
For j = 5 To 10
If v(j, i) <> "" And IsNumeric(v(j, i)) Then
With Worksheets(CStr(v(j, i)))
.Range("cf1,Cj1,co1,cx1").Clear
.Range("cf1") = kumi
.Range("Cj1") = ban
.Range("co1") = lNm
.Range("cx1") = fNm
.PageSetup.Orientation = xlLandscape
.PrintPreview
End With
End If
Next
Next
End Sub
Private Sub zAcceptSe(ByRef startnum As Long, ByRef endnum As Long)
Dim a As Variant
Dim b As Variant
a = Application.InputBox("開始する組と番を数値で入力して下さい", "開始組＆番", "11", , , , , 1)
If TypeName(a) = "Boolean" Then End
startnum = a
b = Application.InputBox("終了する組と番を数値で入力して下さい", "終了組＆番", "13", , , , , 1)
If TypeName(a) = "Boolean" Then End
endnum = b
End Sub
です。
よろしくお願いします。
（すず） 2021/06/14(月) 12:05
こんにちは ちょっと、出かけていまして、おそくなりました え～と。。。コードは変更していないけど。 列をＡ列で一列挿入したというか、Ｂ列からと言う事と、 実際の情報はご説明の通り、組、番とも、数値でよろしいですか。m(__)m （隠居じーさん） 2021/06/14(月) 14:11
こんにちは ＾＾
Option Explicit
Sub OneInstanceMain02()
Dim i As Long
Dim j As Long
Dim s As Long
Dim e As Long
Dim v() As Variant
Dim sretu As Long
Dim eretu As Long
Dim kumi As Long
Dim ban As Long
Dim lNm As String
Dim fNm As String
Dim r As Range
zAcceptSe s, e
With Worksheets("SheetA")
Set r = .Cells(1).CurrentRegion
Set r = r.Offset(, 1).Resize(, r.Columns.Count - 1)
v = r.Value
End With
For i = 1 To UBound(v, 2)
If s = CLng(v(1, i) & v(2, i)) Then sretu = i
If e = CLng(v(1, i) & v(2, i)) Then eretu = i
Next
For i = sretu To eretu
kumi = v(1, i)
ban = v(2, i)
lNm = v(3, i)
fNm = v(4, i)
For j = 5 To 9
If v(j, i) <> "" And IsNumeric(v(j, i)) Then
With Worksheets(CStr(v(j, i)))
.Range("A1,C1,E1,J1").Clear
.Range("A1") = kumi
.Range("C1") = ban
.Range("E1") = lNm
.Range("J1") = fNm
.PageSetup.Orientation = xlLandscape
.PrintPreview
End With
End If
Next
Next
Set r = Nothing
Erase v
End Sub
Private Sub zAcceptSe(ByRef startnum As Long, ByRef endnum As Long)
Dim a As Variant
Dim b As Variant
a = Application.InputBox("開始する組と番を数値で入力して下さい", "開始組＆番", "11", , , , , 1)
If TypeName(a) = "Boolean" Then End
startnum = a
b = Application.InputBox("終了する組と番を数値で入力して下さい", "終了組＆番", "13", , , , , 1)
If TypeName(a) = "Boolean" Then End
endnum = b
End Sub
これと入れ替えて、やってみてくださいませ。m(__)m
（隠居じーさん） 2021/06/14(月) 14:21
あ、すみません、すず さんが書込みアドレス変えた分変更してません また御手間ですが変えて下さいね。。。m(__)mm(__)mm(__)m あとでこちらも変えておきます。 ↑幽霊コマンド修正削除しました。←あっても害はありません＾＾； （隠居じーさん） 2021/06/14(月) 14:25
ちなみに、印刷プレビューで毎回止まるのですが、
それなしに全部印刷するようにはできるものでしょうか。
（すず） 2021/06/14(月) 17:02
.PrintPreview これを .PrintOut に 変えれば実際に印刷機にデーターを送りますよ (*^^*)ｖ m(__)m （隠居じーさん） 2021/06/14(月) 17:50
追伸 こんばんは ＾＾ ただ、実際は、情報の存在の仕方、印刷設定等によってとんでもない 結果[例、情報が一部欠損、エラーで停止等々]起こらないとも言い切 れません。良く、ＶＢＡの範囲指定の仕方など、勉強されて、コード の内容をよく、ご理解の上で、保守運用する事を、老婆心ながらお勧 めいたします。範囲の確定は、一番気を遣う部分の一つで御座います わたしはですが。。。m(_ _)m （隠居じーさん） 2021/06/14(月) 18:31
ここまでできちゃうと欲が出てきてしまって…
入力sheetを1行1列ずつ挿入して、A1セルにマクロボタンを設置できたら最高だと思ってしまいました。
その場合は、どのように変更すればよいでしょうか。
あつかましくてすいません。
（すず） 2021/06/15(火) 15:29
こんばんは ＾＾ ↓ の部分が SheetA の実際の情報を配列に格納している部分です
With Worksheets("SheetA")
Set r = .Cells(1).CurrentRegion
Set r = r.Offset(, 1).Resize(, r.Columns.Count - 1)
v = r.Value
End With
なので
With Worksheets("SheetA")
Set r = .Cells(1).CurrentRegion
Set r = r.Offset(1, 2).Resize(, r.Columns.Count - 2)
v = r.Value
End With
でたぶんいけるかと思います
With Worksheets("SheetA")
.Activate
Set r = .Cells(1).CurrentRegion
Set r = r.Offset(1, 2).Resize(, r.Columns.Count - 2)
r.select
v = r.Value
End
End With
とすると、範囲だけ選択してコードは終了します
選択範囲が実際の処理範囲と間違いないか確認[視認]して
もれ等なければ要らないコード
.Activate 親オブジェクト【シート】をアクテブにする
r.select 範囲を選択
End コードを強制終了(￣▽￣；)
を消しておきましょう。
数値をいろいろ変えてよぉすを見て下さいませ
なぁ～んとなく何やってるかおわかりいただけるかも。。。(*^^*)ｖ
でA1にお気に入りの画像、とかボタン、図形、でも手動で貼り付けて
それに実行するマクロを登録すればよいですよ。
でわでわ
m(_ _)m
（隠居じーさん） 2021/06/15(火) 17:14
すみません 行がずれていました。。。m(_ _)m ↓ に変えて選択範囲見て下さい。
With Worksheets("SheetA")
.Activate
Set r = .Cells(1, 1).CurrentRegion
Set r = r.Offset(1, 2).Resize(r.Rows.Count - 1, r.Columns.Count - 2)
r.Select
v = r.Value
End
End With
（隠居じーさん） 2021/06/15(火) 17:50
その後、データ数が多いから別の仕様を先輩に言われてしまいました。
できないからと断り続けていたのですが、外堀を埋められた感じです。
８月中と言われましたが、無理っぽいです。
でも、最初のやつはできたので、その線で何とかできないか、頑張ってお願いしようかとも考えています。
本当に、大変遅くなってすいませんでした。
（すず） 2021/08/17(火) 09:25
と同じかたでしたら ここはこのままで、新規スレッドの方で 問題点等、お聞きしてよろしいですか。 元 隠居じーさん m(_ _)m
（隠居Ｚ） 2021/08/17(火) 10:32
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.