Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


35809 / 76732 ←次へ | 前へ→

【46117】Re:ユーザーフォームのリストを検索→転記
回答  かみちゃん E-MAIL  - 07/1/23(火) 11:09 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>>下記コードでListBox1の表示が42行目までしか表示しないのですが
>
>sheetにより表示される行数が違います。
>これは外部データのコード.xlsを呼び出しているからでしょうか
>現在のbookにコード.xlsを取り込んだほうがいいのでしょうか?
>コード.xls上でユーザーフォーム3を呼び出した場合は表示されるんですがね

大変申し訳ありません。
[46086]で以下の修正コードを提示させていただいた際に、セル範囲の指定を
誤っています。

以下、[46086]の私の発言内容です。

>すみません。私、間違っていました。
>以下のように★の行を追加してください。
>
>Private Sub UserForm_Initialize()
> Dim ws As Worksheet
>
> Set ws = Workbooks("コード.xls").Sheets("Sheet1")
> With Range("A1", Cells(Rows.Count, 3).End(xlUp))
>  Me.ListBox1.ColumnCount = .Columns.Count
>  Me.ListBox1.ColumnWidths = "30 pt;50 pt;40 pt"
>  ws.Activate '★
>  Me.ListBox1.RowSource = .Address
>  ThisWorkbook.Activate '★
> End With
>End Sub

最初に提示した[46067]では対応していたのですが、上記の
 With Range("A1", Cells(Rows.Count, 3).End(xlUp))

 With ws.Range("A1", ws.Cells(Rows.Count, 3).End(xlUp))
としていただく必要があります。

>>試行錯誤[46092]夜遅くまでやってみたのですが残念ながら・・・降参です。
>
>であれば、もう、初めから作るしかないのでしょうか(T_T)

ということでお詫びの印に動くと思われるコードを提示させていただきます。
一応、要件とおりにはなっていると思いますが、UserForm3の要件がよくわかりません

'==================================================
'■Sheet5("発注")モジュール([46031]より)
'==================================================
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

'==================================================
'■UserForm2モジュール
' (テキスト.txtから検索条件部分一致を選択肢とする)
' (部分一致は全角半角、大文字小文字を無視)
'==================================================

'UserForm初期化処理
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

'検索条件を入力後、部分一致するデータをComboBoxへ追加
Private Sub CommandButton1_Click()
' Dim FName As String
 Dim cnsFILENAME As String '★
 Dim intFF As Integer
 Dim strREC As String
 Dim GYO As Long
 
 'FName = ThisWorkbook.Path + "C:\テキスト.txt"
 'Const cnsFILENAME = "C:\テキスト.txt"
 cnsFILENAME = ThisWorkbook.Path + "\テキスト.txt" '★

 intFF = FreeFile
 Open cnsFILENAME For Input As #intFF
 GYO = 1
 Do Until EOF(intFF)
  Line Input #intFF, strREC
  'UserForm2.ListBox1.AddItem strREC
  If StrConv(StrConv(strREC, vbWide), vbUpperCase) _
   Like "*" & StrConv(StrConv(Me.TextBox1.Value, vbWide), vbUpperCase) & "*" Then
   Me.ComboBox1.AddItem strREC '★
  End If
 Loop
End Sub

'ComboBoxの選択値をアクティブセルへ転記
Private Sub CommandButton2_Click()
 ActiveCell.Value = Me.ComboBox1.Value
 Unload Me
End Sub

'ComboBoxの選択肢を消去
Private Sub CommandButton3_Click()
 Me.ComboBox1.Clear
End Sub

'==================================================
'■UserForm3モジュール
' (コード.xlsから指定範囲すべてを選択肢とする)
'==================================================

'UserForm初期化処理
Private Sub UserForm_Initialize()
 Me.Left = 150
 Me.Top = 100
End Sub

'コード.xlsのA1セル〜C列の最終列までをComboBoxへ追加
Private Sub CommandButton1_Click()
 Dim WB1 As Workbook
 Dim WB2 As Workbook
 Dim strFileName As String
 Dim ws As Worksheet

 Set WB1 = ThisWorkbook
 strFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
 If strFileName <> "False" Then
  Application.ScreenUpdating = False
  'すでに開いているかどうかをチェックする
  If Not ChkWorkbook(Mid(strFileName, InStrRev(strFileName, "\") + 1)) Then
   MsgBox strFileName & vbCrLf & "を開きます"
   Set WB2 = Workbooks.Open(strFileName)
  Else
   Set WB2 = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1))
  End If
  WB1.Activate
  Set ws = WB2.Sheets("Sheet1")
  With ws.Range("A1", ws.Cells(Rows.Count, 3).End(xlUp))
   Me.ComboBox1.ColumnCount = .Columns.Count
   Me.ComboBox1.ColumnWidths = "20 pt;20 pt;20 pt"
   ws.Activate
   '指定範囲の全データをCimboBoxに反映
   '(検索条件の部分一致には対応していない)
   Me.ComboBox1.RowSource = .Address
   WB1.Activate
  End With
  Application.ScreenUpdating = True
 Else
  MsgBox "コード.xlsのファイル選択を中止しました"
 End If
End Sub

'ComboBoxの選択値をアクティブセルへ転記
Private Sub CommandButton2_Click()
 ActiveCell.Value = Me.ComboBox1.Value
 Unload Me
End Sub

'ComboBoxの選択肢を消去
Private Sub CommandButton3_Click()
 Me.ComboBox1.Clear
End Sub

'ブックオープン済みチェック関数
Function ChkWorkbook(strWorkbookName As String) As Boolean
 Dim wb As Workbook

 ChkWorkbook = False
 For Each wb In Workbooks
  If wb.Name = strWorkbookName Then
   ChkWorkbook = True
   Exit For
  End If
 Next
End Function
3 hits

【46028】ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 17:02 質問
【46030】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 17:15 発言
【46031】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 17:33 発言
【46037】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 18:43 発言
【46039】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 20:29 発言
【46043】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 20:46 発言
【46051】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 22:51 発言
【46052】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 23:12 発言
【46057】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 23:32 発言
【46058】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 0:09 発言
【46060】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 0:21 発言
【46061】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 7:15 発言
【46063】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 10:21 発言
【46064】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 11:35 発言
【46067】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 12:18 発言
【46070】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 13:01 発言
【46071】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 13:09 発言
【46066】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 12:04 発言
【46084】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 17:25 発言
【46085】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:06 発言
【46087】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 18:12 発言
【46088】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:23 発言
【46086】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 18:07 発言
【46090】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:45 発言
【46092】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 20:48 発言
【46098】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 21:48 発言
【46099】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 22:07 発言
【46100】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 22:44 発言
【46101】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 22:55 発言
【46106】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 2:51 発言
【46107】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 3:03 発言
【46109】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 7:33 発言
【46114】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 9:28 発言
【46117】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 11:09 回答
【46120】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 14:09 発言
【46121】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 14:42 発言
【46122】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 15:09 発言
【46124】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 16:51 回答
【46129】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 17:33 発言
【46133】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 20:22 発言
【46134】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 20:40 発言
【46139】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/24(水) 3:58 発言
【46140】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/24(水) 7:28 発言
【46157】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/24(水) 20:44 発言
【46159】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/24(水) 20:51 発言
【46168】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/25(木) 0:22 お礼

35809 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free