エクセル ＶＢＡの作成について

質問

初心者なりに、色々参考にさせてもらいながらエクセル・ＶＢＡで、
顧客データと業者コードに入力した数字や文字列を
顧客Noを入力すると請求書に表示される、というＶＢＡを作ったのですが、顧客データの並び順が表に反映されてしまいます、
（例えば顧客NoがNo5だと請求書10行目から順に表示したいのに、13行目に表示されてしまいます。No4だと12行目、No3だと11行目という風に・・）
ws1の、顧客データは、10行目から順に1行ずつ下がって入力したいけど、
ws2の、業者コードの情報は3行目のまま固定して表示したいのです。
こんな場合どうすればいいでしょうか・・？

説明足りなければ申し訳ありません。。
下に、自分で作ったＶＢＡ張っておきます。↓

　　Sub 請求書作成()
Dim getstr As String
Dim msg As String
Dim title As String
Dim irange As Integer
Dim iirange As Integer
　Set ws1 = Worksheets("顧客データ")
　Set ws2 = Worksheets("業者コード")
　Set ws6 = Worksheets("▲請求書▲")

msg = "顧客ＮＯ.を入力してください"
title = "ＮＯ.入力"
getstr = InputBox(msg, title)
getstr = UCase(getstr)
　　irange = Int(getstr) + 4
　　iirange = Int(getstr) + 8

　ws6.Range("a4") = ws1.Range("g" & irange)
　ws6.Range("d3") = ws1.Range("j" & irange)

EndRow = Cells(ws6.Rows.Count, 8).End(xlUp).Row

　ws6.Range("c" & iirange) = ws1.Range("l" & irange)
　ws6.Range("f" & iirange) = ws1.Range("c" & irange)
　ws6.Range("n" & iirange) = ws1.Range("bf" & irange)
　ws6.Range("v" & iirange) = ws1.Range("dh" & irange)
　ws6.Range("ab" & iirange) = ws1.Range("ac" & irange)
　ws6.Range("aw" & iirange) = ws1.Range("dz" & irange)

　ws6.Range("ah" & iirange) = ws2.Range("l" & irange + 2)
End sub

回答No.8

ka_na_de · ベストアンサー

たびたび、ごめんなさい。
さっきとほとんど同じですが、
If EndRow < 10 Then EndRow = 9
に直してなかったので、修正します。

Sub 請求書作成()
　Dim getstr As String
　Dim getval As Double
　Dim msg As String
　Dim title As String
　Dim irange As Integer
　Dim ws1 As Worksheet
　Dim ws2 As Worksheet
　Dim ws6 As Worksheet
　Dim EndRow As Long

　Set ws1 = Worksheets("顧客データ")
　Set ws2 = Worksheets("業者コード")
　Set ws6 = Worksheets("▲請求書▲")

　msg = "顧客ＮＯ.を入力してください"
　title = "ＮＯ.入力"
　getstr = InputBox(msg, title)
　If getstr = "" Then Exit Sub
　getval = Val(getstr)
　If IsNumeric(getval) = False Then GoTo Err
　If getval <= 0 Then GoTo Err
　If Int(getval) <> getval Then GoTo Err

　irange = getval + 4

　EndRow = ws6.Range("C65536").End(xlUp).Row
　If EndRow < 10 Then EndRow = 9

　ws6.Range("A4") = ws1.Range("G" & irange)
　ws6.Range("D3") = ws1.Range("J" & irange)

　ws6.Range("C" & EndRow + 1) = ws1.Range("L" & irange)
　ws6.Range("F" & EndRow + 1) = ws1.Range("C" & irange)
　ws6.Range("n" & EndRow + 1) = ws1.Range("bf" & irange)
　ws6.Range("v" & EndRow + 1) = ws1.Range("dh" & irange)
　ws6.Range("ab" & EndRow + 1) = ws1.Range("ac" & irange)
　ws6.Range("aw" & EndRow + 1) = ws1.Range("dz" & irange)
　Exit Sub

Err:
　MsgBox "顧客Noを入力してください"
End Sub

補足

たびたびご回答いただきありがとうございます。
順番に表示されてはいるのですが、
なぜか、度々51行目に表示されます。

回答No.9

ka_na_de

＃４です。

Ｃ５０に空白は入っていませんか？

入っていないなら、
▲請求書▲シートを新規に作り直してもダメですか？

それでもダメなら、
他のマクロが動いてないでしょうか？

お礼

Sub 請求書作成2()

Dim getstr As String
Dim getval As Double
Dim msg As String
Dim title As String
Dim irange As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws6 As Worksheet
Dim EndRow As Long

Set ws1 = Worksheets("顧客データ")
Set ws6 = Worksheets("請求書")

msg = "顧客ＮＯ.を入力してください"
title = "ＮＯ.入力"
getstr = InputBox(msg, title)
If getstr = "" Then Exit Sub
getval = Val(getstr)
If IsNumeric(getval) = False Then GoTo Err
If getval <= 0 Then GoTo Err
If Int(getval) <> getval Then GoTo Err

irange = getval + 4

　EndRow = ws6.Range("C43").End(xlUp).Row
If EndRow < 10 Then EndRow = 9

ws6.Range("A4") = ws1.Range("G" & irange)
ws6.Range("D3") = ws1.Range("J" & irange)

ws6.Range("C" & EndRow + 1) = ws1.Range("L" & irange)
ws6.Range("F" & EndRow + 1) = ws1.Range("C" & irange)
ws6.Range("n" & EndRow + 1) = ws1.Range("bf" & irange)
ws6.Range("v" & EndRow + 1) = ws1.Range("dh" & irange)
ws6.Range("ab" & EndRow + 1) = ws1.Range("ac" & irange)
ws6.Range("aw" & EndRow + 1) = ws1.Range("dz" & irange)
Exit Sub

Err:
MsgBox "顧客Noを入力してください"
End sub

で、やってみたらいけました！！！

質問が分かりにくいにもかかわらず、ご回答頂きありがとうございました。
ほんとうに助かりました！

補足

遅くなってしまい申し訳ありません。

Ｃ50でなくＣ51だったのですが、Ｃ51の空白を埋めてみても、Ｃ52に表示されます。
以下Ｃ52から順に埋めていってもその下にずれて表示されます、、
違うシートに作ってみましたが、これもまた同じ結果になりました。
別のマクロは動かしていないし動いていないです。

もう少し検証してみます。

回答No.7

ka_na_de

＃４です。

すみません。
場当たり的に訂正したせいで、余計なエラーが
でたようです。
再度修正したので試してください。

尚、50行目から出力されたとのことですが、
おそらく、もとのシートのC49に何か入力されていた
可能性があります。（空白など）

結果を教えてください。

Sub 請求書作成()
　Dim getstr As String
　Dim getval As Double
　Dim msg As String
　Dim title As String
　Dim irange As Integer
　Dim ws1 As Worksheet
　Dim ws2 As Worksheet
　Dim ws6 As Worksheet
　Dim EndRow As Long

　Set ws1 = Worksheets("顧客データ")
　Set ws2 = Worksheets("業者コード")
　Set ws6 = Worksheets("▲請求書▲")

　msg = "顧客ＮＯ.を入力してください"
　title = "ＮＯ.入力"
　getstr = InputBox(msg, title)
　If getstr = "" Then Exit Sub
　getval = Val(getstr)
　If IsNumeric(getval) = False Then GoTo Err
　If getval <= 0 Then GoTo Err
　ws1.Range("A1").Value = getval
　ws1.Range("B1").Value = Int(getval)

　If Int(getval) <> getval Then GoTo Err

　irange = getval + 4

　EndRow = ws6.Range("C65536").End(xlUp).Row
　If EndRow < 10 Then EndRow = 10

　ws6.Range("A4") = ws1.Range("G" & irange)
　ws6.Range("D3") = ws1.Range("J" & irange)

　ws6.Range("C" & EndRow + 1) = ws1.Range("L" & irange)
　ws6.Range("F" & EndRow + 1) = ws1.Range("C" & irange)
　ws6.Range("n" & EndRow + 1) = ws1.Range("bf" & irange)
　ws6.Range("v" & EndRow + 1) = ws1.Range("dh" & irange)
　ws6.Range("ab" & EndRow + 1) = ws1.Range("ac" & irange)
　ws6.Range("aw" & EndRow + 1) = ws1.Range("dz" & irange)
　Exit Sub

Err:
　MsgBox "顧客Noを入力してください"
End Sub

回答No.6

ka_na_de

#4です。

ごめんなさい。
またまた間違ってました。

誤：　Dim getstr As String
正：　Dim getstr As Long

補足

こちらこそ、
さっきの元の方のＶＢＡですが、
入力されないのではなく、下ーの方（50行目）に表示されていました！
しかも順番に表示されていましたので、
これが10行目にくると成功なのですが・・・！
やってみようとしましたが分かりませんでした。

正してみました。
のですが今度は、
If getstr = "" Then Exit Sub
が黄色くなりエラーが起きました。

回答No.5

ka_na_de

＃４です。

間違えました。

誤：　If EndRow < 10 Then EndRow = 10
正：　If EndRow < 10 Then EndRow = 9

回答No.4

ka_na_de

サンプルを作ってみました。
意図している通りであれば幸いです。

おせっかいな指摘ですが、この方法では、
顧客データが確実に連番で入力されていないといけませんね。
顧客Ｎｏが５のデータは絶対に５＋４＝９行目になければ
なりません。
これで実害が無ければ良いのですが、顧客Ｎｏを検索して、
ヒットした行を出力した方が確実だと思いますよ。

Sub 請求書作成()
　Dim getstr As String
　Dim msg As String
　Dim title As String
　Dim irange As Integer
　Dim ws1 As Worksheet
　Dim ws2 As Worksheet
　Dim ws6 As Worksheet
　Dim EndRow As Long

　Set ws1 = Worksheets("顧客データ")
　Set ws2 = Worksheets("業者コード")
　Set ws6 = Worksheets("▲請求書▲")

　msg = "顧客ＮＯ.を入力してください"
　title = "ＮＯ.入力"
　getstr = InputBox(msg, title)
　If getstr = "" Then Exit Sub
　If IsNumeric(getstr) = False Then GoTo Err
　If getstr <= 0 Then GoTo Err
　If Int(getstr) <> getstr Then GoTo Err

　irange = getstr + 4

　EndRow = ws6.Range("C65536").End(xlUp).Row
　If EndRow < 10 Then EndRow = 10

　ws6.Range("A4") = ws1.Range("G" & irange)
　ws6.Range("D3") = ws1.Range("J" & irange)

　ws6.Range("C" & EndRow + 1) = ws1.Range("L" & irange)
　ws6.Range("F" & EndRow + 1) = ws1.Range("C" & irange)
　ws6.Range("n" & EndRow + 1) = ws1.Range("bf" & irange)
　ws6.Range("v" & EndRow + 1) = ws1.Range("dh" & irange)
　ws6.Range("ab" & EndRow + 1) = ws1.Range("ac" & irange)
　ws6.Range("aw" & EndRow + 1) = ws1.Range("dz" & irange)
　Exit Sub

Err:
　MsgBox "番号を入力してください"
End Sub

補足

ご回答ありがとうございます！

上記のＶＢＡで実行してみたのですが、
Ａ4とＤ3のセルにしか表示されませんでした。。

やはり違うシートのバラバラの情報を持ってきて並べるというのは難しいことなのでしょうか？

EndRow = ws6.Range("C65536").End(xlUp).Row
If EndRow < 10 Then EndRow = 10
という部分やEndRowが、良く分かっていないので応用してみたりうまく対処できないです。。
すいません。

回答No.3

n-jun

ANo.2 です。

>"顧客データ"（ws1）のシートは、
>Ｂ５セルから表がはじまり、
>行ごとに各顧客のデータが並んでいます。
>たとえば「1」と入力するとコード「1」の顧客のデータの行から、必要な各列のデータを、
>"請求書"（ws6）シートのＡ4・Ｄ3セルと、
>Ｃ10・Ｆ10・Ｎ10・Ｖ10・ＡＢ10・ＡＨ10・ＡＷ10セルに
まずここでは、顧客Noを入力（InputBox）すると、該当する行に変換（顧客No＋データ開始行）して、請求書（WS6)の各セルに
表示する。

↑の事と、
>10行目の各列から入力し始め、一行ずつ行数を増やして入力。
の関係がよくわからないのですが。

１行ずつ行数を増やして入力、と言っても、WS6は顧客データより呼び出したものが表示されており、
そこへ別のデータを入力している？と言う事でしょうか？

或いは一旦出来上がった請求書データを顧客データに追加していきたいと、
言う事ですか？
それならば、行を増やしていきたいと言うのは理解できますが、
同一の顧客Noが顧客データに発生してしまいます。

”請求書に表示する”と”一行ずつ行数を増やして入力”の関係を明確に
お願いします。

補足

迅速な返信ありがとうございます。

えっと、
メッセージボックスに顧客Noを入力すると、
請求書（ws6）の各セルに顧客Noの情報が表示されるようにしたい。
というのが目的です。
請求書（ws6）のセルには何も表示されておりません。
10行目云々というのは、上の作業を行う際に
一つの顧客のデータを、請求書（ws6）のＣ10から一行ずつ表示していくのですが、
顧客ごとに順に行数を増やしていきたいということです。
ひとつの請求書に、幾つも顧客のデータが入ります。

質問のところで書いているＶＢＡを実行してみると、
請求書（ws6）の各セルに表示までは出来たのですが、行がバラバラでそれが出来なかったのです。

これで説明できてますかね・・？
分かりにくければごめんなさい。

回答No.2

n-jun

各シート構成とやりたい事（箇条書きでも）を提示された方が、
いいと思いますよ。
コードが正しいかどうかは、検証できる質問者さんにしか
わかりませんから。

補足

なるほど、ありがとうございます。
分かりにくいかもですが、文章にまとめてみます。

"顧客データ"（ws1）のシートは、
Ｂ５セルから表がはじまり、
行ごとに各顧客のデータが並んでいます。
たとえば「1」と入力するとコード「1」の顧客のデータの行から、必要な各列のデータを、
"請求書"（ws6）シートのＡ4・Ｄ3セルと、
Ｃ10・Ｆ10・Ｎ10・Ｖ10・ＡＢ10・ＡＨ10・ＡＷ10セルに
に入力され、
10行目の各列から入力し始め、一行ずつ行数を増やして入力。
という作業をしたいのです。
（すいません、"業者コード"（ws2）の表記は必要なかったです。。）

それで、上記のＶＢＡを作成したのですが
いざ実行してみると、顧客データの行数に比例して"請求書"（ws6）に入力されてしまいます。

一行ずつ行を下げて、これらの情報を入力するにはどうすれば良いのでしょうか？

回答No.1

imogasi

模擬実例式に質問に挙げえられないのですかね。
ごたごたした印象で質問が頭にすっと入らない。
ーー
顧客番号指定下として、他（や同一）のシートを「検索」して、顧客番号がヒットした行の他列データ（会社名などデータを）引くものだが、それはどこでやってますか。
ーー
普通顧客番号が入力されれば、社名は顧客データシートから引いて
請求書にセット。その場合VLOOKUP関数などが、短くて最適。
その場合も一々INPUTBOXで聞くのではなく、請求書発行先の顧客番号の入ったシートなりを用意し、行を変えて繰り返し、請求書を印刷
するのが便利です。再発行など、臨時個別発行などなら、個別に１件
顧客番号指定に応じた処理が必要なのはわかるが。
ーー
irange = Int(getstr) + 4
　　iirange = Int(getstr) + 8
は何をやっているのですか。Stringに対してINT（関数？）とは。
チェックしているのですか。むしろVAL（）なら判るが。
ーー
業者コードの項目はどんなもの？
顧客データと分かれている様子は？
業者コードのデータは請求書へ何を引いてくるとき使うのですか。
ーー
回答者に我流のコードを長々と解読させるのでなく、何がやりたいか、文章で書いて、スマート？なコードを勉強したらどうです。
ーー
ws6.Range("f" & iirange) = ws1.Range("c" & irange)
　ws6.Range("n" & iirange) = ws1.Range("bf" & irange)
　ws6.Range("v" & iirange) = ws1.Range("dh" & irange)
　ws6.Range("ab" & iirange) = ws1.Range("ac" & irange)
　ws6.Range("aw" & iirange) = ws1.Range("dz" & irange)
は列が違うだけで、質問での不都合と関係ないと思いませんか。
であれば質問には省略してださず、簡潔にするとか工夫しては。

補足

分かりにくくてすみません。

＞顧客番号指定下として、他（や同一）のシートを「検索」して、顧客番号がヒットした行の他列データ（会社名などデータを）引くものだ
が、それはどこでやってますか。

すみません、分かりません。データは、顧客のシートから請求書のシートへ最後の式で引いてます。

　irange = Int(getstr) + 4
　iirange = Int(getstr) + 8
は、前に質問で教えて頂いた、入力する行の設定です。この場合iangeは4行目、iirangeは8行目から入力という設定らしいです。

業者コードは業者名です。

Sub 請求書作成()
Dim getstr As String
Dim msg As String
Dim title As String
Dim irange As Integer
Dim iirange As Integer　　　　　　　'変数の設定です
　Set ws1 = Worksheets("顧客")
　Set ws2 = Worksheets("業者")
　Set ws6 = Worksheets("請求書")　　'ワークシートの設定です

msg = "顧客ＮＯ.を入力してください"　　
title = "ＮＯ.入力"　　　　　　　　　'メッセージBOXの表示　　　　　　　　　
getstr = InputBox(msg, title)
getstr = UCase(getstr)
　　irange = Int(getstr) + 4
　　iirange = Int(getstr) + 8　　　　'irangeの抽出・iirangeの入力の行数設定です

　ws6.Range("a4") = ws1.Range("g" & irange)
　ws6.Range("d3") = ws1.Range("j" & irange)　　'こちらは入力する場所が常に一定なので、固定したセルを設定しています

EndRow = Cells(ws6.Rows.Count, 8).End(xlUp).Row　　'一行ずつ下がって入力する設定です

　ws6.Range("f" & iirange) = ws1.Range("c" & irange)
　ws6.Range("n" & iirange) = ws1.Range("bf" & irange)
　ws6.Range("v" & iirange) = ws1.Range("dh" & irange)　　'これらは、ws1から引くデータもws6に入力するセルも一行ずつ下がって入力したいので、前の式に対応させるよう最後に持ってきました。

End sub

分かりやすくなったでしょうか？
このような式で処理してみると、どうも
EndRow = Cells(ws6.Rows.Count, 8).End(xlUp).Row　
の式が有効になっていない様なのです。

分かりにくくてすみません、私自身がギリギリで理解しています。。
よろしくお願いします。