Excelのリストボックスの使い方でいじりました。

Option Explicit


Private Declare Function FindWindowEx Lib "User32" _
                    Alias "FindWindowExA" ( _
                    ByVal Hwnd1 As Long, _
                    ByVal Hwnd2 As Long, _
                    ByVal lpsz1 As String, _
                    ByVal lpsz2 As String) As Long

Private Declare Function GetWindowRect Lib "User32" ( _
                    ByVal Hwnd As Long, _
                    lpRect As RECT) As Long

Private Declare Function GetDC Lib "User32" ( _
                    ByVal Hwnd As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
                    ByVal hDC As Long, _
                    ByVal nIndex As Long) As Long

Private Declare Function ReleaseDC Lib "User32" ( _
                    ByVal Hwnd As Long, _
                    ByVal hDC As Long) As Long

Private Const LOGPIXELSX = 88
Private Const POINTS_PER_INCH As Long = 72

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Function PointsPerPixel() As Double
    Dim hDC As Long
    Dim lDotsPerInch As Long

    hDC = GetDC(0&)
    lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    ReleaseDC 0&, hDC
End Function

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    検査データ入力.生産者CD = ListBox1.List(ListBox1.ListIndex)
    検査データ入力.氏名 = ListBox1.List(ListBox1.ListIndex, 2)
    検査データ入力.住所 = ListBox1.List(ListBox1.ListIndex, 1)
    検査データ入力.電話番号 = ListBox1.List(ListBox1.ListIndex, 3)
    農家選択.Hide
    ListBox1.ListIndex = -1
    
End Sub

Private Sub UserForm_Initialize()

    Dim HwndDesk As Long
    Dim HwndChart As Long
    Dim uChartPos As RECT

    Dim Rng As Range

    Dim バージョン As String
    
    バージョン = Application.Version

    If バージョン = "11.0" Then

        Set Rng = ActiveCell(2)

        With Rng.Parent.ChartObjects.Add(0, 0, 1, 1)
            .Top = Rng.Top
            .Left = Rng.Left
            .Activate
            .Delete
        End With

        HwndDesk = FindWindowEx _
                    (Application.Hwnd, 0&, "XLDESK", vbNullString)
        HwndChart = FindWindowEx(HwndDesk, 0&, "EXCELE", vbNullString)
        GetWindowRect HwndChart, uChartPos

        StartUpPosition = 0

        Left = uChartPos.Left * PointsPerPixel
        Top = uChartPos.Top * PointsPerPixel
    End If

    Call UserForm_InitializeCall

End Sub


Private Sub UserForm_Click()

End Sub

Sub UserForm_InitializeCall()
    'Dim dicTmp As Object
    Dim VntTmp As Variant
    'Dim VntV As Variant

    'Set dicTmp = CreateObject("Scripting.Dictionary")　　'ディクショナリーを使わないと要らないでしょう。
    With Worksheets("生産者")
        VntTmp = .Range("A2", .Range("D65536").End(xlUp)).Value

    End With
    
    'If Not IsArray(VntTmp) Then　　　'ここから3行は普通は必要ないようです。
    '    VntTmp = Array(VntTmp)　　　 '上の3行でリストの元を作成してる場合必要ないようです。
    'End If
     
    'For Each VntV In VntTmp　　　　　'この場合のように隙間が無いワークシートから表を作る場合は必要ないようです。
    '    On Error Resume Next
    '    dicTmp.Add VntV, Empty
    '    On Error GoTo 0
    'Next
    
    With 農家選択.ListBox1
     .List = VntTmp
     .ColumnWidths = "30;150;100;20"
     .ColumnCount = 4
    End With
    
    
    'Set dicTmp = Nothing              'ディクショナリーを使わないと要らないでしょう。
    
    農家選択.Show

End Sub

ワークシートからリストボックスのitemを設定するところを、少しだけいじりました。

ほぼ100％丸写しだったので、調べたことを含みで直してみました。でもやはり

隙間があるワークシートから上手く作ることが出来ないので、やはり元の通りの

コードがベターですね。

でもArrayに変更してる箇所があるんですが、これは要らないような気もします。

そもそもがArrayだと思うんです。