Question

我正在尝试使用相同的脚本字典填充两个不同的列表框，但是它不起作用。

我有两个正在运行的潜水艇，一个正在调用另一个。

这是原始Sub（工作代码）：

Option Explicit
Option Base 1

Sub NewWire()

Call PopulateClientName
NewWireForm.Show

End Sub

Sub PopulateClientName()
Dim FileName As String
Dim twb As Workbook, awb As Workbook
Dim aws As Worksheet, tws As Worksheet, ws As Worksheet
Dim rg1 As Range, rg2 As Variant
Dim rCell As Range

'//Clear combobox
DirectCalls.ClientName.Clear
ThirdParty.ClientName.Clear
Transfers.ClientName.Clear


'Open Master Client List
Set twb = ThisWorkbook
Set tws = ThisWorkbook.Worksheets("New")
tws.Visible = True

FileName = "C:\Users\nleon\Documents\Client Master List.xlsx"
Application.ScreenUpdating = False

Workbooks.Open FileName
Set awb = ActiveWorkbook
Set aws = awb.Worksheets("Client Info")
Set ws = awb.Worksheets("Fund Info")
Set rg1 = aws.Range("A1").CurrentRegion
Set rg2 = ws.Range("A2").CurrentRegion

With CreateObject("Scripting.Dictionary")
    For Each rCell In aws.Range("B2", aws.Cells(Rows.Count, "B").End(xlUp))
        If Not .exists(rCell.Value) Then
            .Add rCell.Value, Nothing
        End If
    Next rCell

 DirectCalls.ClientName.List = .Keys
 ThirdParty.ClientName.List = .Keys
 Transfers.ClientName.List = .Keys
 
End With

Call PopulateClientNo(rg1, aws)
Call PopulateFund(rg2, ws)

awb.Close SaveChanges:=False

Application.ScreenUpdating = True


End Sub

Sub PopulateClientNo(rg1 As Range, aws As Worksheet)
Dim ws As Worksheet, wb As Workbook
Dim rCell As Range

'//Clear combobox
DirectCalls.ClientNo.Clear
ThirdParty.ClientNo.Clear
Transfers.ClientNo.Clear


With CreateObject("Scripting.Dictionary")
    For Each rCell In aws.Range("C2", aws.Cells(Rows.Count, "C").End(xlUp))
        If Not .exists(rCell.Value) Then
            .Add rCell.Value, Nothing
        End If
    Next rCell

 DirectCalls.ClientNo.List = .Keys
 ThirdParty.ClientNo.List = .Keys
 Transfers.ClientNo.List = .Keys

End With

End Sub

这是潜艇不起作用：

Sub PopulateFund(rg2 As Variant, ws As Worksheet)
Dim dict As Object, d As Variant
Dim result As Long
Dim i As Integer, j As Integer, v As Variant

CapitalCalls.DCMFund.Clear
CapitalCalls.FundDesc.Clear

d = rg2.Value2
If Not IsArray(d) Then d = Array(d)
Debug.Print IsArray(d)

Set dict = CreateObject("scripting.dictionary")

On Error Resume Next
For i = 2 To UBound(d, 1)
    For j = 2 To 2
        If dict.exists(d(i, j)) = False Then
            dict.Add Key:=d(i, j), Item:=d(i, j + 1)
        Else
            result = result + d(i, j)
        End If
    Next j
Next i

CapitalCalls.DCMFund.List = dict.Keys -----> this isn't actually working
CapitalCalls.FundDesc.List = dict.Item -----> this isn't actually working


End Sub

在名为“ NewWireForm”的用户窗体中，存在以下代码：

Option Base 1

Private Sub CancelButton_Click()
Unload Me
End
End Sub

Private Sub UserForm_Initialize()

    With Frame1
        With .Font
            .Bold = False
            .Name = "Ariel"
            .Size = 14
        End With
    End With

End Sub

Private Sub NextButton_Click()

If TPExpense = True Then
 ThirdParty.Show

ElseIf DCMCC = True Then
 CapitalCalls.Show
 
ElseIf DirectCC = True Then
 DirectCalls.Show

ElseIf Transfer = True Then
 Transfers.Show
 
Else: MsgBox ("You have not selected a wire type. Please try again!.")
End If

End Sub

我希望“首字母大写”用户窗体中的列表中填充字典中的键和项，但它会空白。

有什么想法吗？

Answer 1

根据我上面发布的链接：

Sub UserFormStuff()

    'setup: "UserForm1" is a userform with 2 textboxes
    
    'this code relies on the "default instance"
    UserForm1.TextBox1 = "Test1"
    Test2
    UserForm1.Show '<< only textbox1 has content
    
    'this code uses an explicit instance of the userform
    Dim uf As UserForm1
    Set uf = New UserForm1
    uf.TextBox1 = "Test1 new"
    Test2_new uf   '<< pass our explicit instance to Test2_new
    uf.Show        '<< now both textboxes are populated
    
End Sub

Sub Test2()
    UserForm1.TextBox2 = "Test2" 'this just creates a *new* UserForm1
                                 '  which is not the same as the copy used
                                 '  in the sub which calls this 
End Sub

Sub Test2_new(uf As UserForm1)
    uf.TextBox2 = "Test2"    '<< use the provided instance
End Sub

有没有一种方法可以用脚本字典中的值填充UserForm列表框？

1 个答案: