| |
▼ペコ さん：
>大変申し訳御座いませんが、
>ｺｰﾄﾞ貼り付けまでの流れをもうちょっと詳しく
>お教え頂けないでしょうか。
>宜しくお願い致します。
USerForm1に
TextBoxを5ヶ
各TextBoxの名前 TextBox1, No, 依頼日, 対応日, アフター内容
ComboBoxを1ヶ
ComboBoxの名前 ComboBox1
CommandButtonを1ヶ
CommandButtonの名前 CommandButton1
を貼り付けます。
提示のデータを Sheet1 と Sheet2 に張り付けて
Userform1を実行してみて下さい。
CommandButtonを使用していませんが TextBox1_Exit の内容を
CommandButton1_Click へ張り付ければ宜しいですよ。
その時はTextBox1_Exit の内容を削除
下記をUserformのモジュールへ貼り付け
Option Explicit
Dim RR As Long
' コンボボックスのテキストに変更があった時
Private Sub ComboBox1_Change()
Dim R As Range
If RR = 0 Then Exit Sub
With Worksheets("Sheet2")
.AutoFilterMode = False
With .Range("A1").CurrentRegion
' Sheet2に RR でAutoFilter
.AutoFilter Field:=1, Criteria1:=RR
' Sheet2に コンボボックスの値（月日） でAutoFilter
.AutoFilter Field:=2, Criteria1:=Format(Me.ComboBox1.Value, "m/d")
With .SpecialCells(xlCellTypeVisible)
' データがタイトル行と分かれているか
If .Areas.Count = 1 Then
Set R = .Offset(1).Resize(.Rows.Count - 1)
Else
Set R = .Areas(.Areas.Count)
End If
End With
' 各データのセット
With Me
.No = R.Cells(1, 1).Value
.依頼日 = Format(R.Cells(1, 2).Value, "m/d")
.対応日 = Format(R.Cells(1, 3).Value, "m/d")
.アフター内容 = R.Cells(1, 4).Value
End With
End With
End With
End Sub
' TextBox1からフォーカスを失うとき
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim R As Range
RR = 0
If TextBox1.Text = "" Then Exit Sub
' Sheet1の縦横の空白で囲まれた領域
With Worksheets("Sheet1").Range("A1").CurrentRegion
On Error Resume Next 'エラーでも次へ
' マッチ関数で検索値, 検索領域, 照合の型 0=完全一致
Debug.Print .Offset(0, 1).Resize(, 1).Address '範囲のアドレス
RR = WorksheetFunction.Match(TextBox1.Value, .Offset(0, 1).Resize(, 1), 0)
On Error GoTo 0
' エラーの時は抜ける
If RR = 0 Then Exit Sub
' RRの値が行番だから値をセット
RR = .Cells(RR, 1).Value
End With
' Sheet2の
With Worksheets("Sheet2")
' AutoFilter の解除
.AutoFilterMode = False
' 縦横の空白で囲まれた領域
With .Range("A1").CurrentRegion
' A列で AutoFilterをかける 検索値 = RR
.AutoFilter Field:=1, Criteria1:=RR
' 表示行の値Set
With .SpecialCells(xlCellTypeVisible)
' 抽出データが最初からの場合サンプルでは RRが１のとき
If .Areas.Count = 1 Then
Set R = .Offset(1, 1).Resize(.Rows.Count - 1)
Else
' 抽出データがタイトル行と分かれている時 RR>１のとき
Set R = .Areas(.Areas.Count).Offset(, 1).Resize(, 1)
End If
End With
' コンボボックスに値セット
Me.ComboBox1.List = R.Value
End With
End With
End Sub
Sheet1
No. 氏名 年齢 住所 ････
1 あああ 5 ○○○ ････
2 いいい 10 ■■■ ････
3 ううう 15 △△△ ････
Sheet2
No. 依頼日 対応日 ｱﾌﾀｰ内容 ････
1 1/1 01/02 ○○○ ････
1 2/1 02/02 ○○○ ････
1 3/1 03/02 ○○○ ････
2 4/1 04/02 ■■■ ････
2 5/1 05/02 ■■■ ････
2 6/1 06/02 ■■■ ････
3 7/1 07/02 △△△ ････
3 8/1 08/02 △△△ ････
3 9/1 09/02 △△△ ････
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
