Private Sub UserForm_InitializeCall()
Dim 元表 As Range
Dim i As Long
'Dim dic As Object
Dim 配列 As Variant
Dim C配列 As Variant
With Sheets("米検査日程")
'Set 元表 = .Range("C2", .Range("IV2").End(xlToLeft)).Resize(2)
Set 元表 = .Range("C2", .Range("IV3").End(xlToLeft))
End With
If Not (IsArray(元表)) Then
配列 = Array(元表)
Else
配列 = 元表
End If
配列 = WorksheetFunction.Transpose(配列)
C配列 = 配列
Call 空白行削除(C配列, 配列)
'Set dic = CreateObject("Scripting.Dictionary")
With 検査日選択.ListBox1
.ColumnCount = 2
.ColumnWidths = "70;30"
'.Column = 元表.Value
.List = C配列
'For i = .ListCount - 1 To 0 Step -1
' If Len(.List(i, 0)) = 0 Then
' .RemoveItem i
' ElseIf dic.Exists(.List(i, 0)) Then
' .RemoveItem i
' Else
' dic(.List(i, 0)) = Empty
' End If
'Next
End With
Set 元表 = Nothing
Set C元表 = Nothing
'Set dic = Nothing
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
実際は動いていても、よく分からないところが有ったので、それを変えるとこうなるでしょう。
前は縦の表から、リストボックスのitemを設定しましたが、今回は横の表から作ると
どうなるかですね。
配列 = WorksheetFunction.Transpose(配列)を行えば、縦の表と同じく
出来ると言うことですね。
リストボックスは大体疑問が解決したような気がします。これで終わりですね。