新しいアカウントで始めました。

身の回りの出来事や写真が中心です。

Excelリストボックスで遊んでました。続き。

2015-11-29 21:46:45 | Excel

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(配列)を行えば、縦の表と同じく

出来ると言うことですね。

リストボックスは大体疑問が解決したような気がします。これで終わりですね。


コメント    この記事についてブログを書く
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする
« Excelリストボックスで遊んで... | トップ | 愛用のカメラですか? »
最新の画像もっと見る

コメントを投稿

ブログ作成者から承認されるまでコメントは反映されません。

Excel」カテゴリの最新記事