| |
レス遅くなり申し訳ありません。
前回作ったものと違うのですが、下記のようなものです。
前回はデバッグではエラーにはなりませんでしたが、今回はデバッグの時点でエラー
となります。
Private Sub CommandButton1_Click()
Dim rng As Range, r As Range, rn As Range
Dim vnt As Variant, v, txtList
Dim dicChk As Object
'
txtList = Array("")
With "\db.csv" '←ここがエラーになります。前回はどう記述したか忘れました。
Set rng = .Range("A1", .Range("G65536"))
End With
'
Set dic = CreateObject("Scripting.Dictionary")
Set dicChk = CreateObject("Scripting.Dictionary")
'
For Each v In txtList
For Each rn In rng.Cells
For Each r In rn.Resize(1, 3)
If r.Text Like ("") Then
If dic.exists(v) Then
If dicChk.exists(r.Row & v) Then Exit For
vnt = dic(v)
ReDim Preserve vnt(UBound(vnt) + 1)
vnt(UBound(vnt)) = Cells(r.Row, 1).Resize(1, 7).Value
Else
ReDim vnt(0 To 0)
vnt(0) = Cells(r.Row, 1).Resize(1, 7).Value
End If
dic(v) = vnt
dicChk(r.Row & v) = ""
End If
Next
Next
Next
'
TextBox1.List = txtList
ListBox1.ColumnCount = 7 'ListBox1の列は7列にする
'
Set dicChk = Nothing
Set rng = Nothing
End Sub
Private Sub TextBox1_Change()
ListBox1.List = Application.Transpose(Application. _
Transpose(dic(TextBox1.Value)))
End Sub
Private Sub UserForm_Terminate()
Set dic = Nothing
End Sub
End Sub
|
|
エターナル
- 06/3/20(月) 10:26 -
