□投稿者/ 斎藤 -(2019/08/17(Sat) 12:14:26)
| いつも拝見させて頂いております。
テキストボックスとコンボボックスを用いて条件結果をリストボックスに表示するVBAを作成しようとしていますが、うまくできません。
以下のVBAを実行し、「検索」ボタンで実行しようとすると「書き込みできません」というメッセージが表示されます。
どこで記述を間違えているかご教示いただけますと幸いです。
'----------------------------------------------
'検索を実行します。部分一致検索を行っています。
Private Sub CmdSearch_Click()
Dim lastRow As Long
Dim myData, myData2()
Dim i As Long, j As Long, cn As Long
Dim key1 As String, key2 As String, key3 As String, key4 As String
'顧客コード
If TextBox3.Value = "" Then key1 = "*" Else key1 = "*" & TextBox3.Value & "*"
'顧客名
If TextBox4.Value = "" Then key2 = "*" Else key2 = "*" & TextBox4.Value & "*"
'顧客カナ
If TextBox5.Value = "" Then key3 = "*" Else key3 = "*" & TextBox5.Value & "*"
'顧客分類
Dim ListNo As Long
ListNo = ComboBox1.ListIndex
If ListNo < 0 Then
key4 = "*"
Else
key4 = ComboBox1.List(ListNo)
End If
'検索するデータを配列 myData に格納しています。
With Worksheets("顧客マスタ")
'--- 2018/9/27修正しました
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(1, 1), .Cells(lastRow, 8)).Value
End With
'配列 myData の中で検索で一致したデータを配列 myData2 に格納しています。
ReDim myData2(1 To lastRow, 1 To 3)
For i = LBound(myData) To UBound(myData)
If myData(i, 2) Like key1 And myData(i, 3) Like key2 And myData(i, 4) Like key3 And myData(i, 8) Like key4 Then
cn = cn + 1
myData2(cn, 1) = myData(i, 2) '顧客コード
myData2(cn, 2) = myData(i, 3) '顧客名
myData2(cn, 3) = myData(i, 8) '顧客分類
End If
Next i
'検索で一致したデータをリストボックスに表示します。
With ListBox1
.ColumnCount = 3
.ColumnWidths = "50;130;50"
.List = myData2
'.RowSource = "顧客マスタ!B2:H" & lastRow
'.ColumnHeads = True
End With
End Sub
'----------------------------------------------
'ユーザーフォームの初期設定：リストの全データを表示しています。
Private Sub UserForm_Initialize()
Dim lastRow As Long
Dim myData, myData2()
Dim i As Long, j As Long
'顧客分類シートから参照します。
Dim lr As Long
With Worksheets("顧客分類")
lr = .Range("B" & Rows.Count).End(xlUp).Row
End With
With ComboBox1
.RowSource = "顧客分類!B3:B" & lr
End With
'顧客マスタシートから参照します。
With Worksheets("顧客マスタ")
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(1, 1), .Cells(lastRow, 8)).Value
End With
ReDim myData2(1 To lastRow, 1 To 3)
For i = LBound(myData) To UBound(myData)
myData2(i, 1) = myData(i, 2)
myData2(i, 2) = myData(i, 3)
myData2(i, 3) = myData(i, 8)
Next i
With ListBox1
.ColumnCount = 7
.ColumnWidths = "50;130;0;0;0;0;50"
.List = myData2
.RowSource = "顧客マスタ!B2:H" & lastRow
.ColumnHeads = True
End With
End Sub
|
|
複数条件（部分一致）
/ 斎藤 (19/08/17(Sat) 12:14) #13394 ←Now
上記ツリーを一括表示 / 上記ツリーをトピック表示