| 
    
     |  | ▼かみちゃん さん: またまたすみませんありがとうございます。
 では解決の方から説明いたします。
 まずユーザーフォームの方ですが
 下記コードです。
 テキスト.txtはCドライブ直下に置いてあります。
 
 Private Sub ListBox1_MouseUp(ByVal Button As Integer, _
 ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 ActiveCell.Value = Left(ListBox1.Value, 6)
 Unload Me
 End Sub
 Private Sub UserForm_Initialize()
 Dim FName As String
 FName = ThisWorkbook.Path + "C:\テキスト.txt"
 Const cnsFILENAME = "C:\テキスト.txt"
 Dim intFF As Integer
 Dim strREC As String
 Dim GYO As Long
 
 intFF = FreeFile
 Open cnsFILENAME For Input As #intFF
 GYO = 1
 Do Until EOF(intFF)
 Line Input #intFF, strREC
 UserForm2.ListBox1.AddItem strREC
 Loop
 
 Me.Left = 150
 Me.Top = 100
 End Sub
 
 次にsheet5("発注")モジュールは下記です。
 Private Sub Worksheet_BeforeDoubleClick _
 (ByVal Target As Range, Cancel As Boolean)
 
 If 1 < Target.Count Then Exit Sub 'If Target.Cells.Count > 1 Then[結合セルはこちら]
 On Error Resume Next
 If Not Intersect(Target, Range("S8:S107")) Is Nothing Then
 Cancel = True
 UserForm1.Show vbModeless
 Else
 UserForm1.Hide
 End If
 
 If 1 < Target.Count Then Exit Sub
 On Error Resume Next
 If Not Intersect(Target, Range("R8:R107")) Is Nothing Then
 Cancel = True
 UserForm2.Show vbModeless
 Else
 UserForm2.Hide
 End If
 End Sub
 これで一応テキスト.txt左側6桁の数字をR8からR107のセルに転記
 出来るようになりました。
 しかし
 これから下は今回できなかなというものです。
 1.テキスト.txtの行数が1000行前後ありユーザーフォームを表示させても
 探すのが大変一応アイウエオ順に並んでいる。
 依って
 2.今のリストBOXに表示された脇にテキストボックス1を配し、ここに
 検索値を記入(あいまい検索一部一致しても表示させたい)
 3.その脇にリストBOX2を配しておき上記検索結果を表示
 4.リストBOX2からセルR8からR107のいずれかのセルに転記。
 5.終了
 こんな感じなんですがかみちゃん解りますか?
 よろしくお願いします。
 
 >
 >> リストが約1000行ぐらいあり、探すのが大変なのでテキストBOX1に検索値入力コ
 >> マンドボタンON別のリストボックス2に表示検索は一部でも一致すれば表示したい。
 >> リストボックス2からセルへ転記
 >
 >何がしたいのかが今ひとつわかりません。
 >・どういうリストなのですか?
 > テキストファイルになっているのですか?
 >・TextBox1に検索した意値を入力
 >  ↓
 > CommandButton1をクリック
 >  ↓
 > リスト(テキストファイル)から検索
 >  ↓
 > 検索条件(部分一致)に一致したらListBox2にAdd ← Like 演算子でできる?
 >  ↓
 > ListBox2から転記? ←どのタイミングで?
 >・今どのようなコードになっているのですか?
 > [46029]で、「解決ですよ」と言われても、結局どのように解決なさったのかが
 > わかりません。
 
 
 |  |