Sub UserForm_InitializeCall()
Dim dicTmp As Object
Dim VntTmp As Variant
Dim CpyVnttmp As Variant
Dim VntV As Variant
Dim i As Integer
Dim j As Integer
Set dicTmp = CreateObject("Scripting.Dictionary")
With Worksheets("生産者")
VntTmp = .Range("A2", .Range("D65536").End(xlUp)).Value
End With
'If Not IsArray(VntTmp) Then
' VntTmp = Array(VntTmp)
'End If
i = UBound(VntTmp, 1)
j = UBound(VntTmp, 2)
'VntTmp(10 + 1, 2 + 1) = "Chiba"
CpyVnttmp = VntTmp 'Excelはこれでコピー出来ちゃう
For Each VntV In VntTmp 'VntTmpとVntVは関係ない変数。何故こう書ける。
On Error Resume Next 'ここでやっていることが正確には分からない。
dicTmp.Add VntV, Empty
On Error GoTo 0
Next
Call 空白行削除(CpyVnttmp, VntTmp) '上のi,jと数は同じ
i = UBound(CpyVnttmp, 1) '配列のitemにnullを代入しても
j = UBound(CpyVnttmp, 2) '配列は存在する
With 農家選択.ListBox1
.List = CpyVnttmp
.ColumnWidths = "30;150;100;20"
.ColumnCount = 4
End With
Set dicTmp = Nothing 'ディクショナリーを使わないと要らないでしょう。
農家選択.Show
End Sub
Sub 空白行削除(Ctmp, tmp)
Dim 書込行数 As Long
Dim 実カラム As Long
Dim 実行数 As Long
Dim i As Long
Dim j As Long
実カラム = UBound(tmp, 2)
実行数 = UBound(tmp, 1)
書込行数 = 1
For i = 1 To 実行数
If tmp(i, 1) <> "" Then
For j = 1 To 実カラム
Ctmp(書込行数, j) = tmp(i, j)
Next
書込行数 = 書込行数 + 1
End If
Next
For i = 書込行数 To 実行数
For j = 1 To 実カラム
Ctmp(i, j) = ""
Next
Next
End Sub
よく分からないままで、教えて貰ったコードを使ってましたが、この場合は配列の空白を
削除しないようです。Dictionaryを使えば、同じものコードのものが作られない、空白は
削除されると勘違いしてました。違う場面でもこのコードを使ってました。その場面とは
横に広がるワークシートです。しかも空白が多い。その場合でも旨く行ってたんですが。
疑問ですね。(^0^)