こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

Excel VBA 別ブックを開かずに転記

Excel2007のユーザーフォームについて教えてください。

ユーザーフォームを以下のように作成しました。

■テキストボックス6つ

テキストボックス2→件名
テキストボックス3→数
テキストボックス4→名前
テキストボックス5→備考1
テキストボックス6→備考2

■コマンドボタンが1と3の2つです。

コマンドボタン1→転記と印刷
コマンドボタン3→終了

■シートの構成
 sheet"作成と一覧" 
 1行目を以下の項目で使用しています。

 A1→番号(テキストボックス1を表示)
 B1→件名(テキストボックス2を表示)
 C1→数(テキストボックス3を表示)


 sheet"印刷"

 A1→番号(テキストボックス1を表示)
 A2→件名(テキストボックス2を表示)
 B2→数(テキストボックス3を表示)
 A3→名前(テキストボックス4を表示)
 A4→備考1(テキストボックス5を表示)
 A5→備考2(テキストボックス6を表示)

テキストボックスに入力した値を2つのシートにそれぞれ転記して、
シート"印刷"を2部印刷しています。

ここまで以下のコードで行いました。


Private Sub CommandButton1_Click()

'入力値を作成と一覧シートに転記

行 = ActiveCell.Row
列 = ActiveCell.Column
Cells(行, 列) = UserForm1.TextBox1.Value
Cells(行, 列 + 1) = UserForm1.TextBox2.Value
Cells(行, 列 + 2) = UserForm1.TextBox3.Value

'入力値を印刷シートにに転記
Worksheets("印刷").Range("A1") = UserForm1.TextBox1.Value
Worksheets("印刷").Range("A2") = UserForm1.TextBox2.Value
Worksheets("印刷").Range("B2") = UserForm1.TextBox3.Value
Worksheets("印刷").Range("A3") = UserForm1.TextBox4.Value
Worksheets("印刷").Range("A4") = UserForm1.TextBox5.Value
Worksheets("印刷").Range("A5") = UserForm1.TextBox6.Value

部数 = 2
Worksheets("印刷").PrintOut Copies:=部数, Collate:=True

UserForm1.TextBox1.SetFocus
Cells(行 + 1, 列).Select

End Sub

Private Sub CommandButton3_Click()
'終了ボタンで値をクリアしてウィンドウを閉じる
Dim Ctrl As Control

For Each Ctrl In Controls
If TypeName(Ctrl) = "TextBox" Then _
Ctrl.Value = ""
Next Ctrl
Unload Me
End Sub


教えて頂きたい事なのですが・・・

コマンドボタン1の入力値を作成と一覧シートに転記の所なのですが、
アクティブセルではなく、常にA列の最後の値の次の空白行に転記するようにしたい場合、
どのように書き換えればいいのでしょうか?

もう一点ですが、
別ブックにテキストボックス1から6が入力された一覧があります。
この別ブックを開かずに、
テキストボックス1に入力された番号を探して、
テキストボックス2から6に表示されるようにしたいのです。

うまく説明できないのですが・・・

別ブックの名前は"たちつ"

別ブックは、あいうサーバーの
かきくフォルダの中のさしすフォルダです。

ブック"たちつ"に"一覧"というシートがあります。

一覧のシートのD列の3行目以降には番号が入力されており、日々増えています。

テキストボックス1に入力された番号を、
一覧のD列から探し、
I列の値をテキストボックス2へ
K列の値をテキストボックス3へ
L列の値をテキストボックス4へ
M列の値をテキストボックス5へ
J列の値をテキストボックス6へ転記させたいのです。

同じブックの別シートを参照するときには
Application.VLookupで出来たのですが、
マクロの記録でやってみても、解決できませんでした。

コードをご覧いただいてお分かりの通り、
VBA超初心者です。
ネットを見ながら試行錯誤している状況です。

コードの間違い等あるかもしれませんが、
ご教示よろしくお願いいたします。

投稿日時 - 2014-01-29 22:31:35

QNo.8452824

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

>アクティブセルではなく、常にA列の最後の値の次の空白行に転記するようにしたい

「アクティブセル」になってる部分を修正するだけです。

変更前:
行 = ActiveCell.Row
列 = ActiveCell.Column

変更後:
行 = cells(rows.count, 1).end(xlup).offset(1).Row
列 = 1




>もう一点ですが、

一つのご相談投稿では、1つのご質問内容で。
これはこちらのような質問相談掲示板での、ごく一般的なマナーなので覚えておいてください。




>別ブックを開かずに、

まぁ、有体に言って初心者さんがよく陥りがちな、「無駄な努力」です。



>テキストボックス1に入力された番号を探して、
>テキストボックス2から6に表示されるようにしたい

private sub CommandButton2_Click()
 if textbox1 = "" then exit sub
 application.screenupdating = false
 range("A1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,6,FALSE)"
 range("B1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,8,FALSE)"
 range("C1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,9,FALSE)"
 range("D1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,10,FALSE)"
 range("E1").formula = "=VLOOKUP(" & textbox1 & "'\\あいうサーバ\かきく\さしす\[たちつ.xls]一覧'!D:M,7,FALSE)"
 textbox2 = range("A1").value
 textbox3 = range("B1").value
 textbox4 = range("C1").value
 textbox5 = range("D1").value
 textbox6 = range("E1").value
 range("A1:E1").clearcontents
 application.screenupdating = true
end sub

以上で、たちつブックを一切開かずに、安全に値を取ってくることができます。
なお、たちつブックの拡張子が不明なので、適切に修正してください。
IDがたちつブックに載ってなかったら、みたいなご相談の「想定外」については、適切に対処を考えてマクロに組み込んでください。

投稿日時 - 2014-01-30 00:29:36

補足

ご教示ありがとうございます。
やってみたのですが、途中で別ブックを選択するウィンドウが出てしまって上手いように進みませんでした。
もう少し時間がかかりそうです。

取り急ぎご報告です。

投稿日時 - 2014-01-30 22:17:56

あなたにオススメの質問