Вытащите диапазон данных в список - PullRequest
Новая
       5

Вытащите диапазон данных в список

0 голосов
/ 29 августа 2018

Я получил диапазон данных, в котором у меня есть 10 столбцов, и я хотел бы перетащить эти данные в список.

Вот мой код: - при запуске я получил ошибку компиляции. 

Sub PullDataIntoListBox()

Dim LRow As Long
Dim LCol As Long
Dim MTable
EditData.Show

With Worksheets("MainDataBase")
    LRow = Cells(Rows.Count, "A").End(xlUp).Row
    LCol = Cells(4, Columns.Count).End(xlToLeft).Column
    MTable = Range(Cells(5, 1), Cells(LRow, LCol))
End With

With EditData
    .ColumnCount = UBound(MTable, 2)
    .List = MTable

End With
End Sub

1 Ответ

0 голосов
/ 29 августа 2018

Как сказал @Cyril. Используйте событие Initialize, чтобы при заполнении формы список заполнялся.

Поскольку код находится в форме, вы можете ссылаться на форму, используя ключевое слово Me.

Использование массива в качестве источника: 

Private Sub UserForm_Initialize()

    Dim LRow As Long, LCol As Long
    Dim MTable As Variant

    With Worksheets("MainDataBase")
        LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LCol = .Cells(4, .Columns.Count).End(xlToLeft).Column
        MTable = .Range(.Cells(5, 1), .Cells(LRow, LCol))
    End With

    With Me.ListBox1
        .ColumnCount = UBound(MTable, 2)
        .List = MTable
    End With

End Sub

Или, если вы предпочитаете иметь код в обычном модуле, вы можете вызвать его из события Initialize :

В форме: 

Private Sub UserForm_Initialize()

    PullDataIntoListBox Me.ListBox1

End Sub

В обычном модуле: 

Public Sub PullDataIntoListBox(lstbx As MSForms.ListBox)

    Dim LRow As Long, LCol As Long
    Dim MTable As Variant

    With Worksheets("MainDataBase")
        LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LCol = .Cells(4, .Columns.Count).End(xlToLeft).Column
        MTable = .Range(.Cells(5, 1), .Cells(LRow, LCol))
    End With

    With lstbx
        .ColumnCount = UBound(MTable, 2)
        .List = MTable
    End With

End Sub

Использование диапазона в качестве источника: 

Private Sub UserForm_Initialize()

    Dim LRow As Long, LCol As Long
    Dim MTable As Range

    With Worksheets("MainDataBase")
        LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LCol = .Cells(4, .Columns.Count).End(xlToLeft).Column
        Set MTable = .Range(.Cells(5, 1), .Cells(LRow, LCol))
    End With

    With Me.Controls("ListBox1")
        .ColumnCount = MTable.Columns.Count
        .RowSource = "'" & MTable.Parent.Name & "'!" & MTable.Address
    End With

End Sub

Чтобы открыть форму и заполнить список, вы просто используете EditData.Show. 

Sub SomeOtherProcedure()

    EditData.Show

End Sub

Edit:
Если вы хотите, чтобы два экземпляра одной и той же формы были открыты, но использовали разные значения в списке, вы можете использовать код, подобный следующему:

В обычном модуле добавьте этот код: 

Option Explicit

Public colForms As New Collection

'Accepts a range reference as an argument which is passed to the ListBox control on the form.
'The form reference is then added to the colForms collection.
Sub OpenInstance(ListRange As Range)

    Dim frm As New EditData

    With frm.Controls("ListBox1")
        .ColumnCount = ListRange.Columns.Count
        .RowSource = "'" & ListRange.Parent.Name & "'!" & ListRange.Address
    End With

    colForms.Add frm, CStr(frm.Hwnd)

End Sub

'Starts two new forms, passing a different range to each one.
'Each form in the colForms collection is then displayed.
Sub OpenForms()

    Dim f As Variant

    OpenInstance ThisWorkbook.Worksheets("MainDataBase").Range("A1:D16")
    OpenInstance ThisWorkbook.Worksheets("Sheet2").Range("D3:E5")

    For Each f In colForms
        f.Show vbModeless
    Next f

End Sub

'Called when the form closes.
'The form is hidden before removing it from the collection.
Sub CloseForm(Hwnd As String)
    colForms(Hwnd).Hide
    colForms.Remove Hwnd
End Sub

В форме добавить этот код: 

Option Explicit

'Code for capturing forms Hwnd taken from:
'https://colinlegg.wordpress.com/2016/05/06/getting-a-handle-on-userforms-vba/
#If Win64 Then

    Private Declare PtrSafe Function FindWindowA _
        Lib "user32.dll" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr

    Private mlnghWnd As LongPtr

    Public Property Get Hwnd() As LongPtr
        Hwnd = mlnghWnd
    End Property

#Else

    Private Declare Function FindWindowA _
        Lib "user32.dll" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

    Private mlnghWnd As Long

    Public Property Get Hwnd() As Long
        Hwnd = mlnghWnd
    End Property

#End If

Private Sub UserForm_Initialize()

    StorehWnd

End Sub

Private Sub StorehWnd()

    Dim strCaption As String
    Dim strClass As String

    'class name changed in Office 2000
    If Val(Application.Version) >= 9 Then
        strClass = "ThunderDFrame"
    Else
        strClass = "ThunderXFrame"
    End If

    'remember the caption so we can
    'restore it when we're done
    strCaption = Me.Caption

    'give the userform a random
    'unique caption so we can reliably
    'get a handle to its window
    Randomize
    Me.Caption = CStr(Rnd)

    'store the handle so we can use
    'it for the userform's lifetime
    mlnghWnd = FindWindowA(strClass, Me.Caption)

    'set the caption back again
    Me.Caption = strCaption

End Sub

Private Sub CommandButton1_Click()
    CloseForm CStr(Me.Hwnd)
End Sub
...