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

解決済みの質問

VBAでコンボボックスとテキストボックスの連動

業務命令でVBAの勉強を始めました。
フォームの作成を始めたところなのですが、早くもつまづいてしまい、先に進めません。
どうかご教授をお願いいたします。

現在Book1でユーザーフォームを作成しています。
別なブックBook2のSheet1にあるデータでコンボボックス とテキストボックスを連動させたいと考えております。
Book2のSheet1では、A列に会社名、B列に会社ID、C列に電話番号の表があります。

ComboBox1で会社名を選択したときに、TextBox1にその会社の会社ID、TextBox2に電話番号を表示させるにはどのようにしたらいいのでしょうか?

ネットで検索しながらフォーム作成をしており、似たような条件のコードを自分なりに修正してやってみましたがどうやっても動作しません。
どうかよろしくお願いいたします。

投稿日時 - 2020-05-09 17:14:20

QNo.9746365

困ってます

質問者が選んだベストアンサー

No1の訂正です。

Set FRange = .Range(.Cells(2, "A"), .Cells(LastRow, "C")).Find(FStr, LookAt:=xlWhole)



Set FRange = .Range(.Cells(2, "A"), .Cells(LastRow, "A")).Find(FStr, LookAt:=xlWhole)

でした。


No1のComboBox1_Changeは遅いので以下のようにすれば早くなります。

Private Sub ComboBox1_Change()
Dim i As Long

With ComboBox1
i = 2
Do While ExecuteExcel4Macro("'C:\ok\[Book2.xlsx]Sheet1'!R" & i & "C1") <> 0
If .Value = ExecuteExcel4Macro("'C:\ok\[Book2.xlsx]Sheet1'!R" & i & "C1") Then
TextBox1.Value = ExecuteExcel4Macro("'C:\ok\[Book2.xlsx]Sheet1'!R" & i & "C2")
TextBox2.Value = ExecuteExcel4Macro("'C:\ok\[Book2.xlsx]Sheet1'!R" & i & "C3")
Exit Do
End If
i = i + 1
Loop
End With

End Sub

投稿日時 - 2020-05-09 19:11:41

お礼

kkkkkm様、ありがとうございます。
1行ずつ調べながら作業をしており、お礼まで時間がかかってしまいました。

おかげさまで希望の動きとなったのですが、マクロが[実行中]のままになってしまいます。
■ボタンで停止をすることはできますが、何か他の方法はございませんでしょうか?

投稿日時 - 2020-05-10 13:38:17

ANo.2

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

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

回答(7)

ANo.7

>理解しようとしてみたのですが・・・、無理でした。
SQLは今後いろいろな局面で活用できますので
DBのイロハをマスターする必要がありますが、
ぜひ克服してほしいところです。

>ただマクロが[実行中]のままになってしまいます。
VBAのフォームが開いているわけですから
開いている間は,VBAは実行中です。
が、だからといって「困った」はないはずです。

もしフォームが開いている状態で
Book1のシートを操作したいのであれば

Private Sub CommandButton1_Click()
 UserForm1.Show vbModeless
End Sub

といったコードに変更します。

投稿日時 - 2020-05-10 14:38:02

お礼

ありがとうございます。
これから勉強を進めていっていつか理解できるようになりたいと思います。

実行中の件はそのままでもよかったのですね。
大変失礼いたしました。

色々教えていただきまして、ありがとうございます。

投稿日時 - 2020-05-10 15:21:03

ANo.6

> ファイルを開くのに時間がかかっているのだと思います。

勘違いでした。フォームを開いているので「実行中」になります。それで正常です。フォームを閉じれば「実行中」は消えます。

投稿日時 - 2020-05-10 14:08:41

お礼

ありがとうございます。
このままで問題なかったのですね。
素人すぎる質問失礼いたしました。

投稿日時 - 2020-05-10 15:19:39

ANo.5

> おかげさまで希望の動きとなったのですが、マクロが[実行中]のままになってしまいます。

VBEのタイトルバーのところで「実行中」と出ているのだと思いますが、ファイルを開くのに時間がかかっているのだと思います。

No2のComboBox1_Change()のコードで試してみてください。

投稿日時 - 2020-05-10 14:01:47

ANo.4

No3の補足です。

Book1.xlsmとBook2.xlsxは同じフォルダーに配置されている前提です。
また、Book2.xlsxは
(開いていてもかまいませんが)
あえて、開いておく必要はありません。

投稿日時 - 2020-05-09 20:40:42

ANo.3

ちょっとハードルが上がりますが、SQL文を使う対応を紹介します。

添付画像のようにコードを配置します。

以下、画像ではあふれているModule1のコードが以下です。

Option Explicit

Sub 会社一覧表示()

 Dim SQL As String
 Dim cn As Object
 Dim rs As Object
 
 'SQL全文を組み立て、実行
 SQL = "SELECT *" & vbCrLf
 SQL = SQL & "FROM [" & "Sheet1" & "$A1:Z50000]" & vbCrLf
 Set cn = CreateObject("ADODB.Connection")
 Set rs = CreateObject("ADODB.Recordset")
 cn.Provider = "Microsoft.ACE.OLEDB.12.0"
 cn.Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=1"
 cn.Open ThisWorkbook.Path & "\" & "Book2.xlsx"
 rs.Open SQL, cn
 
 If rs.EOF And rs.Bof Then
  MsgBox "抽出結果が0レコード"
  Exit Sub
 End If
 rs.MoveFirst
 Do
  If rs.EOF = True Then Exit Do
  UserForm1.ComboBox1.AddItem rs("会社名")
  rs.MoveNext
 Loop

 '後処理
 rs.Close
 Set rs = Nothing
 cn.Close
 Set cn = Nothing

End Sub

Sub 詳細表示()
 Dim SQL As String
 Dim cn As Object
 Dim rs As Object

 'SQL全文を組み立て、実行
 SQL = "SELECT *" & vbCrLf
 SQL = SQL & "FROM [" & "Sheet1" & "$A1:Z50000]" & vbCrLf
 SQL = SQL & "Where [会社名] = '" & UserForm1.ComboBox1.Text & "'" & vbCrLf
 
 Set cn = CreateObject("ADODB.Connection")
 Set rs = CreateObject("ADODB.Recordset")
 cn.Provider = "Microsoft.ACE.OLEDB.12.0"
 cn.Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=1"
 cn.Open ThisWorkbook.Path & "\" & "Book2.xlsx"
 rs.Open SQL, cn
 
 If rs.EOF And rs.Bof Then
  MsgBox "抽出結果が0レコード"
  Exit Sub
 End If
 rs.MoveFirst
 UserForm1.TextBox1.Text = rs("会社ID")
 UserForm1.TextBox2.Text = rs("電話番号")

 '後処理
 rs.Close
 Set rs = Nothing
 cn.Close
 Set cn = Nothing

End Sub

大変申し訳ございませんが、この投稿に添付された画像や動画などは、「BIGLOBEなんでも相談室」ではご覧いただくことができません。 OKWAVEよりご覧ください。

マルチメディア機能とは?

投稿日時 - 2020-05-09 20:30:47

お礼

HohoPapa様、ありがとうございます。
理解しようとしてみたのですが・・・、無理でした。
とりあえずコピーして使わせていただいたら希望通りに動きました。
ただマクロが[実行中]のままになってしまいます。
■ボタンで停止をすることはできますが、何か他の方法はございませんでしょうか?

投稿日時 - 2020-05-10 13:38:28

ANo.1

ユーザーフォームのプロシージャに以下を記載してください。
Book2の1行目は項目行で2行目から実際の会社名が入っていると考えています。
TextBox1にその会社の会社ID、TextBox2に電話番号を表示させるときが遅いと思います。Book1の別のシートにBook2のSheet1のデータを参照させておいてそちらを使った方がいいかもしれません。
Book2は閉じたままで実行してください。

C:\ok\[Book2.xlsx]Sheet1
は実際のブックのフォルダ名及びブック名とシート名に

Private Sub UserForm_Initialize()
Dim i As Long

With ComboBox1
i = 2
Do While ExecuteExcel4Macro("'C:\ok\[Book2.xlsx]Sheet1'!R" & i & "C1") <> 0
.AddItem ExecuteExcel4Macro("'C:\ok\[Book2.xlsx]Sheet1'!R" & i & "C1")
i = i + 1
Loop
End With
End Sub

'↓これがバックでファイルを開いているのでその分時間がかかると思います。
Private Sub ComboBox1_Change()
Dim FStr As String, LastRow As Long
Dim ex As New Excel.Application
Dim mPath As String
Dim wb As Workbook
Dim FRange As Range

FStr = ComboBox1.Value
mPath = "C:\ok\Book2.xlsx" '実際のフォルダとブック名に
Set wb = ex.Workbooks.Open(Filename:=mPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
With wb.Worksheets("Sheet1") '実際のシート名に
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
TextBox1.Value = _
Application.WorksheetFunction.VLookup(FStr, .Range(.Cells(2, "A"), .Cells(LastRow, "C")), 2, False)
TextBox2.Value = _
Application.WorksheetFunction.VLookup(FStr, .Range(.Cells(2, "A"), .Cells(LastRow, "C")), 3, False)

' Findを使うこともできますがどちらも遅いと思います。
' Set FRange = .Range(.Cells(2, "A"), .Cells(LastRow, "C")).Find(FStr, LookAt:=xlWhole)
' If Not FRange Is Nothing Then
' TextBox1.Value = FRange.Offset(0, 1).Value
' TextBox2.Value = FRange.Offset(0, 2).Value
' End If

End With
Call wb.Close
Call ex.Application.Quit
End Sub

投稿日時 - 2020-05-09 19:01:59

あなたにオススメの質問