VBA リストボックス(複数条件)で検索⇒転記方法
VBA初心者です。
入門書を読み、コンボボックスを用いる(一つの条件検索)で請求書ツール作成までできたのですが、画像のようにユーザーフォームに複数選択リストを設けると現在のコードですと、エラーになってしまいます。
つきましては、リストボックスで条件を複数選択可能にして、該当データを転記するといったことを行いたいです。大変恐縮ですが、コードをご教示お願い致します。
↓参考に、現状のコードを下記致します。
(ユーザーフォームのコード)
Private Sub btnExit_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim ListRange As Range
Dim temp As Range
Dim vYear As Long
Dim i As Long
With Worksheets("取引先一覧").Range("A1").CurrentRegion
Set ListRange = .Resize(.Rows.Count - 1).Offset(1)
End With
For Each temp In ListRange
cmbcompany.AddItem temp.Value
Next
vYear = Year(Date)
cmbYear.AddItem vYear - 1
cmbYear.AddItem vYear
cmbYear.AddItem vYear + 1
cmbYear.Value = vYear
For i = 1 To 12
cmbMonth.AddItem i
Next
End Sub
Private Sub btnMakeBill_Click()
MakeBill cmbcompany.Text, cmbYear.Text, cmbMonth.Text
End Sub
(標準モジュールのコード)
Option Explicit
Sub Main()
frmMakeBill.Show
End Sub
Sub MakeBill(ByVal vCompany As String, ByVal vYear As Long, ByVal vMonth As Long)
Dim TargetSheet As Worksheet
Dim vDate As Date
Dim DataRange As Range
Dim TargetRange As Range
Dim BillBook As Workbook
Dim i As Long, vRow As Long
Dim vInfo(1 To 2) As String
On Error Resume Next
Worksheets("請求書Template").Copy After:=Worksheets(Worksheets.Count)
If Err.Number <> 0 Then
MsgBox "「請求書Template」ワークシートが見つかりません。確認下ください"
Exit Sub
End If
On Error GoTo 0
On Error GoTo ErrHdl
Set TargetSheet = Worksheets(Worksheets.Count)
Set TargetRange = TargetSheet.Range("A18")
i = 1
vRow = 1
With Worksheets("受注データ").Range("A9")
Do Until .Cells(i, 1).Value = ""
vDate = .Cells(i, 1).Value
If .Cells(i, 2).Value = vCompany _
And Year(vDate) = vYear And Month(vDate) = vMonth Then
TargetRange.Cells(vRow, 1).Value = .Cells(i, 1).Value '「日付」列
TargetRange.Cells(vRow, 2).Value = .Cells(i, 3).Value '「商品コード」列
TargetRange.Cells(vRow, 3).Value = .Cells(i, 4).Value '「商品名」列
TargetRange.Cells(vRow, 4).Value = .Cells(i, 5).Value '「数量」列
TargetRange.Cells(vRow, 5).Value = .Cells(i, 6).Value '「単価」列
TargetRange.Cells(vRow, 6).Value = .Cells(i, 7).Value '「金額」列
vRow = vRow + 1
End If
i = i + 1
Loop
TargetSheet.Range("F28").Formula = "=SUM(F18:F27)" '「小計」
TargetSheet.Range("F29").Formula = "=F28 * 0.08" '「消費税額」
TargetSheet.Range("F30").Formula = "=F28 + F29" '「合計金額」
TargetSheet.Range("B6").Formula = "F30" '請求額
vInfo(1) = Date
vInfo(2) = vCompany
TargetSheet.Range("F2").Value = vInfo(1) '「請求日」
TargetSheet.Range("A6").Value = vInfo(2) '「請求先」
End With
Set BillBook = Workbooks.Add
TargetSheet.Cells.Copy BillBook.Worksheets(1).Range("A1")
Application.DisplayAlerts = False
TargetSheet.Delete
Application.DisplayAlerts = True
Exit Sub
ErrHdl:
MsgBox "エラーが発生しました。処理を終了します"
End Sub
補足
お早いご回答ありがとうございます! G5:H6の部分は "!B1:B":"!C1:C" ということでしょうか? 初心者ですみません。。。