0

条件付き重複ありのリストボックス昇順表示
・参照シートB4から下にL4:L29がリストで入力できるようになっています。
・参照シートA4から下に日付をフォームで入力できるようになっています。
A:日付,B:科目が入力済み ・現在A列日付行Ｂ列にＬ4:Ｌ5が入力されている日付を重複ありで記入順にリストボックスで表示させています。
※表示される日付を昇順にしたいです。
よろしくお願いいたします。


Private Sub UserForm_Initialize()

Me.StartUpPosition = 0
Me.Left = 856
Me.Top = 138

'タイトルを設定
Me.Caption = "入力フォーム"
Label1.Caption = "入金日"
Label2.Caption = "入金金額"
Label3.Caption = "科目"
CommandButton1.Caption = "追加入金"

'リストを設定
Dim ws As Worksheet, r As Range

Set ws = Worksheets("入出金帳簿")

For Each r In ws.Range("B4", ws.Range("B" & Rows.Count).End(xlUp))

With ListBox1

.ColumnWidths = .Width - 6 & ",0,0,0"

Select Case r.Value
Case "集金"
.AddItem Format(r.Offset(0, -1).Value, "m月d日")
.List(.ListCount - 1, 1) = r.Value
.List(.ListCount - 1, 2) = r.Offset(0, 1).Value
.List(.ListCount - 1, 3) = r.Offset(0, -1).Value
Case "振込"
.AddItem Format(r.Offset(0, -1).Value, "m月d日")
.List(.ListCount - 1, 1) = r.Value
.List(.ListCount - 1, 2) = r.Offset(0, 2).Value
.List(.ListCount - 1, 3) = r.Offset(0, -1).Value
End Select

End With

Next r

End Sub



Private Sub CommandButton1_Click()

Dim r As Range, tr As Range, flg As Boolean

If ListBox1.ListIndex < 0 Then Exit Sub

ActiveCell.Activate

flg = False
Set tr = ActiveCell.Offset(0, 2).Resize(5, 1)

For Each r In tr

With ListBox1
If r.Value = "" Then
r.NumberFormat = "yyyy/m/d"
r.Value = .List(.ListIndex, 3)
r.Offset(0, 1).Value = .List(.ListIndex, 2)
flg = True
Exit For
End If
End With

Next r

If Not flg Then MsgBox "入力または選択を見直して下さい。", vbExclamation, "入力欄オーバー"

End Sub

質問者が選んだベストソリューション

Yahoo!知恵袋 4541日前