Excel VBA質問箱 IV

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

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


52223 / 76736 ←次へ | 前へ→

【29354】Re:任意の行のレコードをユーザフォーム...
発言  Lion  - 05/10/2(日) 18:33 -

引用なし
パスワード
   うくれれ さん
こんばんは
少し長いですが、がんばって下さい。

>「データベースの配列」
>No. 氏名 登録番号1 登録番号2 登録日  発効日  登録型  
>1 XXXX  9999   9999   171001  171002  A-1   
>2  ・   ・    ・     ・    ・    ・
>3  ・   ・    ・     ・    ・    ・
>
>そこで、抽出用にユーザフォームを作り上記データベースの各列に対応するテキストボックス又はリストボックスを配置し、条件(複数指定可)を入力してコマンドボタンクリックでフィルタをかける、なんていうことは可能でしょうか。
>例えば、登録日が170901で登録型がB-2の行をすべて抽出して表示したり、氏名>XXXXの入力された行を抽出して表示する、というように・・・。

下記の準備をして下さい。

UserForm
1)TEXTBOX 1〜7
2) LISTBOX1
3)COMMANDBUTTON 1,2

TEXTBOX1--No
TEXTBOX2--氏名
TEXTBOX3--登録番号1
TEXTBOX4--登録番号2
TEXTBOX5--登録日
TEXTBOX6--発効日
TEXTBOX7--登録番号登録型
COMMANDBUTTON1--検索ボタン
COMMANDBUTTON2--リスト全表示ボタン
に対応しています。

シート構成
作業 というシートを追加して下さい。
Sheet1の3行目A列〜G列まで下記の見出しがあるものとします。
No・氏名・登録番号1・登録番号2・登録日・発効日・登録型
Noは必ず入力されているものとします。

作業というシートは何もしなくていいです。
もし検索できなかったら作業というシートのセルの書式を全部文字列にして下さい。

下記のコードを入力またはコピーして下さい。
各TEXTBOXに検索する文字を入力して検索ボタンクリックして下さい。
検索結果がLISTBOXに表示されます。
リスト全表示ボタンをクリックすると全リストが表示されます。
確認してみて下さい。

確認後、UserForm・シートは、うくれれさんの環境に合わせて下さいね。

'---------------------------------------
Option Explicit
'---------------------------------------
Private Sub CommandButton1_Click()
'-----検索-----
Dim mySHI As Worksheet '作業シート
Dim myRhani As Range '抽出元範囲
Dim myRjouken As Range '抽出条件範囲
Dim myK1 As String 'TEXTBOX1
Dim myK2 As String 'TEXTBOX2
Dim myK3 As String 'TEXTBOX3
Dim myK4 As String 'TEXTBOX4
Dim myK5 As String 'TEXTBOX5
Dim myK6 As String 'TEXTBOX6
Dim myK7 As String 'TEXTBOX7
Dim LASROW As Long '最後のセル
Dim myDRange As String 'リスト表示範囲

ListBox1.ListIndex = -1

myK1 = TextBox1.Value 'No
myK2 = TextBox2.Value '氏名
myK3 = TextBox3.Value '登録番号1
myK4 = TextBox4.Value ' '登録番号2
myK5 = TextBox5.Value '登録日
myK6 = TextBox6.Value '発効日
myK7 = TextBox7.Value '登録型

Set mySHI = Worksheets("作業")
mySHI.Cells.Clear

With Worksheets("Sheet1")
  Set myRhani = .Range(.Range("A3"), .Range("A65536").End(xlUp).Offset(0, 6)) '抽出元範囲
  Set myRjouken = mySHI.Range("A1:G2")                '抽出条件範囲
  '抽出条件をセル範囲上に入力する
  mySHI.Range("A1").Value = .Range("A3").Value 'No フィールドを指定"
  mySHI.Range("B1").Value = .Range("B3").Value '氏名 フィールドを指定"
  mySHI.Range("C1").Value = .Range("C3").Value '登録番号1 フィールドを指定"
  mySHI.Range("D1").Value = .Range("D3").Value '登録番号2 フィールドを指定"
  mySHI.Range("E1").Value = .Range("E3").Value '登録日 フィールドを指定"
  mySHI.Range("F1").Value = .Range("F3").Value '発効日 フィールドを指定"
  mySHI.Range("G1").Value = .Range("G3").Value '登録型 フィールドを指定"
End With

With mySHI
  If TextBox1.Value = "" Then
    .Range("A2").Value = myK1 '抽出条件を指定
    Else
    .Range("A2").Value = "'=" & myK1 '抽出条件を指定
  End If
  
  If TextBox2.Value = "" Then
    .Range("B2").Value = myK2 '抽出条件を指定
    Else
    .Range("B2").Value = "'=" & myK2 '抽出条件を指定
  End If

  If TextBox3.Value = "" Then
    .Range("C2").Value = myK3 '抽出条件を指定
    Else
    .Range("C2").Value = "'=" & myK3 '抽出条件を指定
  End If

  If TextBox4.Value = "" Then
    .Range("D2").Value = myK4 '抽出条件を指定
    Else
    .Range("D2").Value = "'=" & myK4 '抽出条件を指定
  End If

  If TextBox5.Value = "" Then
    .Range("E2").Value = myK5 '抽出条件を指定
    Else
    .Range("E2").Value = "'=" & myK5 '抽出条件を指定
  End If

  If TextBox6.Value = "" Then
    .Range("F2").Value = myK6 '抽出条件を指定
    Else
    .Range("F2").Value = "'=" & myK6 '抽出条件を指定
  End If

  If TextBox7.Value = "" Then
    .Range("G2").Value = myK7 '抽出条件を指定
    Else
    .Range("G2").Value = "'=" & myK7 '抽出条件を指定
  End If
End With

'検索-検索結果を作業シートにコピー
  myRhani.AdvancedFilter _
    Action:=xlFilterCopy, CriteriaRange:=myRjouken, _
      copytorange:=Worksheets("作業").Range("A5")

'検索結果をリスト表示
LASROW = Worksheets("作業").Range("A65536").End(xlUp).Row
myDRange = "作業!A6:G" & LASROW
ListBox1.RowSource = myDRange

If Worksheets("作業").Range("A6").Value = "" Then
  ListBox1.RowSource = ""
End If

End Sub

'---------------------------------------
Private Sub CommandButton2_Click()
'-----リスト全表示-----
Dim f As Long

ListBox1.ListIndex = -1
Worksheets("作業").Cells.Clear

For f = 1 To 7
  Controls("TEXTBOX" & f).Value = ""
Next

Call S_LIST '初期リスト表示

End Sub

'---------------------------------------
Private Sub UserForm_Initialize()
'-----USERFORM初期設定-----
Dim LASROW As Long
Dim mySHI As Worksheet
Dim f As Long

With ListBox1
  .ColumnCount = 7
  .ColumnWidths = "50;50;50;50;50;50;50"
End With

Call S_LIST '初期リスト表示

End Sub

'---------------------------------------
Private Sub S_LIST()
'-----初期リスト表示------
Dim LASROW As Long
Dim myDRange As String

LASROW = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
myDRange = "Sheet1!A4:G" & LASROW
ListBox1.RowSource = myDRange

If Worksheets("Sheet1").Range("B4").Value = "" Then
  ListBox1.RowSource = ""
End If

End Sub
'---------------------------------------

0 hits

【29162】任意の行のレコードをユーザフォームへ貼付け うくれれ 05/9/27(火) 0:01 質問
【29173】Re:任意の行のレコードをユーザフォームへ... Lion 05/9/27(火) 10:29 発言
【29220】Re:任意の行のレコードをユーザフォームへ... うくれれ 05/9/27(火) 21:54 お礼
【29221】Re:任意の行のレコードをユーザフォームへ... うくれれ 05/9/27(火) 22:23 質問
【29224】Re:任意の行のレコードをユーザフォーム... Lion 05/9/27(火) 23:53 発言
【29247】Re:任意の行のレコードをユーザフォーム... うくれれ 05/9/29(木) 1:36 質問
【29253】Re:任意の行のレコードをユーザフォーム... Lion 05/9/29(木) 10:23 発言
【29299】Re:任意の行のレコードをユーザフォーム... うくれれ 05/9/30(金) 1:49 質問
【29311】Re:任意の行のレコードをユーザフォーム... Lion 05/9/30(金) 12:12 発言
【29352】Re:任意の行のレコードをユーザフォーム... うくれれ 05/10/2(日) 2:00 質問
【29354】Re:任意の行のレコードをユーザフォーム... Lion 05/10/2(日) 18:33 発言
【29465】Re:任意の行のレコードをユーザフォーム... うくれれ 05/10/5(水) 22:47 お礼
【29477】Re:任意の行のレコードをユーザフォーム... LION 05/10/6(木) 0:50 発言
【29478】Re:任意の行のレコードをユーザフォーム... LION 05/10/6(木) 0:58 発言
【29639】Re:任意の行のレコードをユーザフォーム... うくれれ 05/10/10(月) 1:46 質問

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