検索対象の行内容を代入してシートを印刷処理

質問

ワークシートにテキストファイルからデータを読み込み、その内容を別のフォーマットシートに貼り付けて印刷することを考えています。

今のところできているコードは以下の通りです。

Private Sub Workbook_Open()

'テキストデータを読み込み
Dim Fname As String 'ファイル名
Dim rw As Long '書き出しの最初の行
Dim j As Long
Dim u As Integer '配列の上限
Dim TextLine As String
Dim LineBuf As Variant 'ラインバッファ
Dim FNo As Integer 'ファイルNo

Sheet1.Select
Fname = Application.GetOpenFilename("tstnama(*.txt),*.txt")
If Fname = "False" Then
Exit Sub
End If
rw = 1
FNo = FreeFile()
Open Fname For Input As #FNo 'ファイルインポート
Do Until EOF(FNo)
Line Input #FNo, TextLine
LineBuf = Split(TextLine, "|") '配列の取り出し,区切り文字は、「|」
u = UBound(LineBuf)
If u >= 0 Then
ActiveSheet.Cells(rw + j, 1).Resize(, u + 1).Value = LineBuf
End If
j = j + 1
Loop
Close #FNo

'533の件数検索
Dim TargetStr As String, LastRow As Integer
Dim TargetArea As Range, FoundCell As Range
Dim R As Integer, N As Integer

TargetStr = "533"
LastRow = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
Set TargetArea = Range(Cells(1, 1), Cells(LastRow, 1))
Set FoundCell = TargetArea.Find(what:=TargetStr, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)

If Not FoundCell Is Nothing Then
R = FoundCell.Row
N = 1
Do
Set FoundCell = TargetArea.FindNext(after:=FoundCell)
If FoundCell.Row = R Then Exit Do
N = N + 1
Loop
Else
MsgBox "該当データがありません", vbCritical
End If
Set FoundCell = TargetArea.FindPrevious(after:=FoundCell)
'印刷件数の確認と印刷フェーズへの移行処理
If vbYes = MsgBox("B796K533は" & N & " 件です。印刷しますか？", vbYesNo) Then
R = FoundCell.Row
N = 1
Do
With Sheet2
.Cells(4, 4).Value = Sheet1.Cells(R, 2).Value
.Cells(5, 4).Value = Sheet1.Cells(R, 3).Value
.Cells(6, 4).Value = Sheet1.Cells(R, 4).Value
.Cells(7, 4).Value = Sheet1.Cells(R, 5).Value & " " & Sheet1.Cells(R, 6).Value & " " & Sheet1.Cells(R, 7).Value
.Cells(8, 4).Value = Sheet1.Cells(R, 8).Value
.Cells(9, 4).Value = Sheet1.Cells(R, 9).Value
.PrintPreview
End With
MsgBox N & "枚目プリント"
Set FoundCell = TargetArea.FindNext(after:=FoundCell)
If FoundCell.Row = R Then Exit Do
N = N + 1
Loop
Else
MsgBox "該当データがありません", vbCritical
End If

Set FoundCell = Nothing
Set TargetArea = Nothing

End Sub

テキストファイルの内容はシートに貼り付けたとき8列になっておりA列には重複する番号が数パターン振られていて行当たりはダブりません。

A列にある特定の文字列(コード内では533)の件数を検索し、それぞれの行内容をシートに代入して、そのシートを印刷しますので
「533の数を確認(印刷される枚数を確認)」
↓
「検索された533の行内容を上から順番(A1~A*)に印刷」
という段取りで行きたいと思っています。

コードを走らせると、533の件数はちゃんと合うのですがその行内容が反映されません。変数Foundcellが印刷フェーズに入った段階でA1の行に固定されているようでその行内容が件数分印刷されてしまいます。(コードではPrintPreviewなのでプレビュー画面で確認しています。)

Foundcellへの渡し方がわるいのでしょうか？それとも、やはり特定の行内容を取得するには別に主キーのようなものを振らなければだめでしょうか？

533の後ろには534というように何パターンかあってそれらもあてがわれたフォーマットに代入して印刷していきたいので、これができれば後は繰り返しになりますから後一歩なのですが・・・。

回答No.1

Wendy02 · ベストアンサー

こんにちは。

最初に、直接ではないのですが、スキルとしては、あと、もうちょっとだと思います。
今回は、前回と違って、私は、なるべく、そのコードに沿った方法で書いたほうが良いと思いました。別の方法もありますが、どうしても、今は、Find メソッドのテクニックはきちんと書けるようにしておいたほうがよいです。（ここは、そういうことを教える場ではありませんが。）

ベテラン風の変則的なスキルでコーディングにするのは、将来的には妨げになってしまいます。某有名サイトのコードなどは、みなさんに人気があるようですが、そんな書き方は、何の得にもならないように思っています。

それから、基本的なことですが、プロシージャは、それぞれの仕事(タスク）に割り振ることが大事です。理由は修正がしやすいからです。

ですから、テキスト・インポートと印刷とは、今回は分けたほうがよいです。

>'印刷フェーズへの移行処理
というようなスタイルは、確かに将来的にはそういう方法もあるとは思いますが、コードの造り方が違います。

>533の後ろには534というように何パターンかあってそれらもあてがわれたフォーマットに代入して印刷していきたいので、これができれば後は繰り返しになりますから後一歩なのですが・・・。

もしも、大量に数がある場合は、こういうスタイルでは時間が掛かるので、もう少し工夫が必要だと思います。

・
・
・
Call FindNum
'-------------------------
Sub FindNum()
'単独のプロシージャとします。
　　'533の件数検索
　　Dim TargetStr As String, LastRow As Integer
　　Dim TargetArea As Range, FoundCell As Range
　　Dim r As Integer, N As Integer
　　Dim firstR As Integer

　　TargetStr = "533"
　　LastRow = Cells(Rows.Count, 1).End(xlUp).Row
　　Set TargetArea = Range(Cells(1, 1), Cells(LastRow, 1))
　　Set FoundCell = TargetArea.Find(What:=TargetStr, _
　　　　　　　　　 LookIn:=xlValues, _
　　　　　　　　　 LookAt:=xlWhole, _
　　　　　　　　　 SearchOrder:=xlByRows, _
　　　　　　　　　 SearchDirection:=xlNext, _
　　　　　　　　　 MatchCase:=False)
　　If Not FoundCell Is Nothing Then
　　　　r = FoundCell.Row
　　　　N = 1
　　　　sPrintout r, N
　　　　Do
　　　　　　Set FoundCell = TargetArea.FindNext(After:=FoundCell)
　　　　　　N = N + 1
　　　　　　r = FoundCell.Row
　　　　　　If r = firstR Then Exit Do
　　　　　　sPrintout r, N
　　　　Loop Until FoundCell Is Nothing
　　Else
　　　　MsgBox "該当データがありません", vbCritical
　　End If
　　Set FoundCell = Nothing
　　Set TargetArea = Nothing

End Sub
Sub sPrintout(r As Integer, N As Integer)
'サブルーチン
Dim ret As VbMsgBoxResult
　　With Sheet2
　　　　ret = MsgBox("B796K533は" & N & " 件です。印刷しますか？", vbOKCancel)
　　　　　　If ret = vbOK Then
　　　　　　.Cells(4, 4).Value = Sheet1.Cells(r, 2).Value
　　　　　　.Cells(5, 4).Value = Sheet1.Cells(r, 3).Value
　　　　　　.Cells(6, 4).Value = Sheet1.Cells(r, 4).Value
　　　　　　.Cells(7, 4).Value = Sheet1.Cells(r, 5).Value & " " & Sheet1.Cells(r, 6).Value & _
　　　　　　" " & Sheet1.Cells(r, 7).Value
　　　　　　.Cells(8, 4).Value = Sheet1.Cells(r, 8).Value
　　　　　　.Cells(9, 4).Value = Sheet1.Cells(r, 9).Value
　　　　　　.PrintPreview
　　　　　　MsgBox N & "枚目プリント"
　　　　ElseIf ret = vbCancel Then
　　　　　 End　'強制離脱
　　　　End If
　　End With
End Sub

なお、
　MsgBox N & "枚目プリント"
の部分は、違う方法が可能ですが、とりあえず、そのままにしておきます。

補足

前回に引き続き有難うございます。

返答が遅くなりすみませんでした。2日ほど時間を見つけて思案していおりました。

提示していただいたコードでは変数firstRが宣言のみになっていた為動きませんでした。なのでAddressで代用しました。また、印刷枚数を確認してから印刷に移りたいのでやっぱり二回検索をかけるしかないと思い以下のようにしました。

Call FindNum

Sub FindNum()
'533の件数検索
Dim TargetStr As String, LastRow As Integer
Dim TargetArea As Range, FoundCell As Range
Dim r As Integer, N As Integer
Dim fstad As String

TargetStr = "533"
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set TargetArea = Range(Cells(1, 1), Cells(LastRow, 1))
Set FoundCell = TargetArea.Find(What:=TargetStr, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

'件数確認ループ
If Not FoundCell Is Nothing Then
fstad = FoundCell.Address
r = FoundCell.Row
N = 1
Do
Set FoundCell = TargetArea.FindNext(After:=FoundCell)
N = N + 1
r = FoundCell.Row
If FoundCell.Address = fstad Then Exit Do
Loop While Not FoundCell Is Nothing And _
FoundCell.Address > fstad
Else
MsgBox "該当データがありません", vbCritical
End If
If vbCancel = MsgBox("533は" & N & "件あります。印刷しますか？", vbOKCancel) Then
Exit Sub
End If

'印刷作業へ
If Not FoundCell Is Nothing Then
fstad = FoundCell.Address
r = FoundCell.Row
N = 1
sPrintout r, N
Do
Set FoundCell = TargetArea.FindNext(After:=FoundCell)
N = N + 1
r = FoundCell.Row
If FoundCell.Address = fstad Then Exit Do
sPrintout r, N
Loop Until FoundCell Is Nothing
Else
MsgBox "該当データがありません", vbCritical
End If
Set FoundCell = Nothing
Set TargetArea = Nothing
Call FindNum2
End Sub

Sub sPrintout(r As Integer, N As Integer)
'サブルーチン
With Sheet2
.Cells(4, 4).Value = Sheet5.Cells(r, 2).Value
.Cells(5, 4).Value = Sheet5.Cells(r, 3).Value
.Cells(6, 4).Value = Sheet5.Cells(r, 4).Value
.Cells(7, 4).Value = Sheet5.Cells(r, 5).Value & " " & Sheet5.Cells(r, 6).Value & _
" " & Sheet5.Cells(r, 7).Value
.Cells(8, 4).Value = Sheet5.Cells(r, 8).Value
.Cells(9, 4).Value = Sheet5.Cells(r, 9).Value
.PrintPreview
End With
End Sub

No2については今見たばかりなので、1日ほどお時間下さい。

印刷フェーズへの移行についてですが、書き方が違うとはどういったことでしょうか？私が買いあさった書籍のなかにはそういった記述はありませんでした。書き方として定型があることはまったく知りません。コードを後から見るときに分かりやすくするようになんとなく書いたコメントですから。

回答No.3

Wendy02

こんにちは。

ここの内容だけを取り出して、返事をつけておきます。

>印刷フェーズへの移行についてですが、書き方が違うとはどういったことでしょうか？

定型というものはありません。ただ、その「印刷フェーズ（局面）」というのは、私が想像していたものがあります。

手順の問題なのですが、印刷フェーズ(印刷の局面--つまり印刷のみにして処理していく段階を作る、と読みました）という手法は、Findメソッドなどの検索していったものを、配列変数やコレクション・オブジェクトにため込んでいく方法です。

ただ、私は、今、ここまで作り上げたものには、その必要性がないような気がしたのです。VBAの作り方としては、構造化とまでは言いませんが、分散型にするだけで完璧な内容だと思いました。

>私が買いあさった書籍のなかにはそういった記述はありませんでした。
多くのVBAのテキストは、一つのプロシージャを取り上げているものがほとんどですが、実際の場では、いくつものプロシージャを組み合わせたり、サブルーチンにしたりして、つなぎ合わせていく、という手法をとります。こういう書き方をしていくと、コードも本格的になっていくかと思います。

今回、私が想像した「印刷のフェーズをまとめる」というのは、印刷というよりも、プリンタに送るというAction（行為）は、Excelの中でも、まったく違う段階の部分で、負荷の多い部分ではないかと思います。

セル--プリンタへの出力という段階で、もしかしたら、一気に行ったほうが（ExcelのApplicationに対して）楽で、速いのではないのか、とも考えていました。

具体的には、
Sub sPrintout(r As Integer, N As Integer)

のr の引数の部分は、単にひとつでなくてもいいのではないか、言い換えると、この部分を、配列にしてしまってもよいのではないか、ということです。

全体が量的に、見えているなら、そのように作ってしまったほうが、分散化もしやすく、負担も少ないのではないか、という想像もしています。しかし、また、内容的には、難しくなり手直しも面倒になってしまうと思うのです。

「印刷フェーズへの移行」という言葉で、私が想像したのは、こういうことでした。

お礼

遅くなりました。

回答者様のほうが道具を多くお持ちだと思うので全て理解したとは思いませんが、組み立てるということを前提に考えるという頭では私自身もいるつもりです。

そこで、プロシージャに分ける分けないは、おそらく一定以上の規模で物を作ったことが会って初めて自然に出てくる考えなのかもしれません。私はせいぜい今回程度量でもちょっと多いなと思ってしまいますから（＾＾；）

しかし、ある意味ではプロシージャに分けてまとまりを作りながら組まないのでいつまでたっても、クラスや階層を意識して理解できないのかもしれません。今回の反省ざいりょうですね。

あまり、こちらにお世話にならないよう来年からもがんばります。回答者様もよいお年を

ありがとうございました。

回答No.2

Wendy02

なお、以下の件については、

>533の後ろには534というように何パターンかあってそれらもあてがわれたフォーマットに代入して印刷していきたいので、これができれば後は繰り返しになりますから

Sub Main()
Dim n As Variant
For Each n In Array(533,534,535,536,537)
　FindNum n
Next
End Sub

Sub FindNum(n As Variant)
'単独のプロシージャとします。
　'533の件数検索
　Dim LastRow As Integer　'TargetStr As String を取ります
　Dim TargetArea As Range, FoundCell As Range
　Dim r As Integer, N As Integer
　Dim firstR As Integer

　TargetStr = CStr(n)
・（あとはサブルーチンも含めて同じ）
・
・

このようにすればよいです。

お礼

有難うございます。

配列や、構造体のことなどは知識としてちょっと噛んではいましたが私のスキル的に(というよりプログラムの全体像を把握できる思考法？)が足りないので最初にあげたようにとにかく「処理を順次並べる」という方法をとっていましたが、この例では単独の検索処理コードを省けるのが目に見えて分かります。

乱用するというわけではありませんが、繰り返し処理がはいって処理項目数が多い場合は、今後毎回検討してみようと思います。