Excel VBA質問箱 IV

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

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


35812 / 76738 ←次へ | 前へ→

【46120】Re:ユーザーフォームのリストを検索→転記
発言  yasu  - 07/1/23(火) 14:09 -

引用なし
パスワード
   ▼かみちゃん さん:
>
>大変申し訳ありません。
>[46086]で以下の修正コードを提示させていただいた際に、セル範囲の指定を
>誤っています。
>
>以下、[46086]の私の発言内容です。
>
>最初に提示した[46067]では対応していたのですが、上記の
> With Range("A1", Cells(Rows.Count, 3).End(xlUp))
>を
> With ws.Range("A1", ws.Cells(Rows.Count, 3).End(xlUp))
>としていただく必要があります。

そーだったんですかws.だけでね・・・・・
少しのミスでも簡単に動いてくれないもんなんですね
私のやり方が悪いと思いいろんなところいじっちゃいました。
ひとついいですかコード.xlsのデータは1394行でフォームに表示されるのは
3つまえ1391行までしか表示しないのですが誤差???

>>>試行錯誤[46092]夜遅くまでやってみたのですが残念ながら・・・降参です。

>
>ということでお詫びの印に動くと思われるコードを提示させていただきます。
>一応、要件とおりにはなっていると思いますが、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

おぉ〜これはgood・goodです。


>'==================================================
>'■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

思い通りです。完!


★下記3は、2同様検索機能をつけてもらえませんか
テキストボックスは配置済みです。
>'==================================================
>'■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
0 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 お礼

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