| |
▼ペコ さん：
こんにちは。
USerForm1に
TextBoxを5ヶ
Object Name TextBox1, No, 依頼日, 対応日, アフター内容
ComboBoxを1ヶ
Object Name ComboBox1
CommandButtonを1ヶ
Object Name CommandButton1
を貼り付け提示のデータを Sheet1 と Sheet2 に張り付けて
Userform1を実行してみて下さい。
CommandButtonを使用していませんが TextBox1_Exit の内容を
CommandButton1_Click へ張り付ければ宜しいですよ。
その時はTextBox1_Exit の内容を削除
下記をUserformのモジュールへ貼り付け
尚、Sheet2のB列の書式は ユーザー設定で mm/dd にして下さい。
Option Explicit
Dim RR As Long
Private Sub ComboBox1_Change()
Dim R As Range
With Worksheets("Sheet2")
.AutoFilterMode = False
With .Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=RR
.AutoFilter Field:=2, Criteria1:=Format(Me.ComboBox1.Value, "mm/dd")
With .SpecialCells(xlCellTypeVisible)
Debug.Print .Areas.Count
If .Areas.Count = 1 Then
Set R = .Offset(1).Resize(.Rows.Count - 1)
Else
Set R = .Areas(.Areas.Count)
End If
End With
Debug.Print R.Address
With Me
.No = R.Cells(1, 1).Value
.依頼日 = Format(R.Cells(1, 2).Value, "mm/dd")
.対応日 = Format(R.Cells(1, 3).Value, "mm/dd")
.アフター内容 = R.Cells(1, 4).Value
End With
End With
End With
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim R As Range
RR = 0
If TextBox1.Text = "" Then Exit Sub ' 入力が無い
With Worksheets("Sheet1").Range("A1").CurrentRegion
On Error Resume Next
RR = WorksheetFunction.Match(TextBox1.Value, .Offset(0, 1).Resize(, 1), 0)
On Error GoTo 0
If RR = 0 Then Exit Sub ' 対象が無い
RR = .Cells(RR, 1).Value
End With
With Worksheets("Sheet2")
.AutoFilterMode = False
With .Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=RR
With .SpecialCells(xlCellTypeVisible)
Set R = .Offset(1, 1).Resize(.Rows.Count - 1)
End With
Me.ComboBox1.List = R.Value
End With
End With
End Sub
>ｼｰﾄ1
>No. 氏名 年齢 住所 ････
> 1 あああ 5 ○○○ ････
> 2 いいい 10 ■■■ ････
> 3 ううう 15 △△△ ････
>
>ｼｰﾄ2
>No. 依頼日 対応日 ｱﾌﾀｰ内容 ････
> 1 1/1 1/2 ○○○ ････
> 1 2/1 2/2 ○○○ ････
> 1 3/1 3/2 ○○○ ････
> 2 4/1 4/2 ■■■ ････
> 2 5/1 5/2 ■■■ ････
> 2 6/1 6/2 ■■■ ････
> 3 7/1 7/2 △△△ ････
> 3 8/1 8/2 △△△ ････
> 3 9/1 9/2 △△△ ････
>
|
|
Yuki
- 13/8/17(土) 11:26 -
