使用包含10列以上列的数组填充列表框 - 获取行而不是列

时间:2017-04-05 11:00:17

标签: arrays vba excel-vba listbox populate

我使用列表框在库存管理系统中显示订单数据。

将Ordernumber输入文本框。按CommandButton1搜索表中的相应值。然后使用找到的记录的行号用数字

填充数组

以下选项不起作用,因为VBA中的列表框元素限制为10列

With ListBox2
  ListBox2.ColumnCount = 10
  .AddItem
  .List(listBoxPos, 0) = Sheets("Tabelle1").Cells(rZelle.Row, "A").Value 
  .List(listBoxPos, 1) = Sheets("Tabelle1").Cells(rZelle.Row, "C").Value
  '... 
  .List(listBoxPos, 9) = Sheets("Tabelle1").Cells(rZelle.Row, "R").Value
End With

不幸的是,我需要超过10列。这些列不在范围内(彼此不相邻,有些不需要)

我需要以下列A,C,D,E,S,T,U,V,W,R(F到P由其他方法处理并写入2个变量)

现在我试图形成一个数组并写下值

Dim rZelle        As Range
Dim sSuchbegriff  As String
Dim listBoxPos  As Integer
Dim matchcodeLs As String
Dim matchcodeNew As String



'Variables for each item that is going to be added to ListBox
Dim matchcodePos As String
Dim bestnr As String
Dim artnr As String
Dim farbcode As String
Dim bemerkung As String
Dim ordertyp As String
Dim lieferdat As String
Dim hzlt As String
Dim kommision As String
Dim fnr As String
Dim size As String
Dim amount As String

'Arrays that i tried to use to populate ListBox
Dim auftrpos(12) As String
Dim auftrpos2() As Variant


'Checks if value exists in TextBox
If Trim$(TextBox1.Value) <> "" Then
    sSuchbegriff = Trim$(TextBox1.Value)
Else
    MsgBox "Sie müssen einen Suchbegiff eingeben!", _
    48, "   Hinweis für " & Application.UserName
    Exit Sub
End If
'Search in the Column A of Table for Value from TextBox
With ThisWorkbook.Worksheets("Tabelle1").Columns(1)

'sets variable rZelle with found value
Set rZelle = .Find(What:=sSuchbegriff, LookAt:=xlWhole, LookIn:=xlValues)
    'when value is found
    If Not rZelle Is Nothing Then


        '(other code and stuff....)
        
        
                    'Going through column F to P and filling Variable Amount and Size
                    
                    If Not Sheets("Tabelle1").Cells(rZelle.Row, "F").Value = "" Then
                        'Sheets("Sheet1").Cells(ind + 3, "C").Value = 34
                        size = "34"
                        amount = Sheets("Tabelle1").Cells(rZelle.Row, "F").Value
                    End If
                    
                    '(........ ....... ....)
                    
                    If Not Sheets("Tabelle1").Cells(rZelle.Row, "P").Value = "" Then
                        'Sheets("Sheet1").Cells(ind + 3, "C").Value = ""
                        size = "X"
                        amount = Sheets("Tabelle1").Cells(rZelle.Row, "P").Value
                    End If
                    
            
            
                    'Populating the first array
                    auftrpos(0) = Sheets("Tabelle1").Cells(rZelle.Row, "A").Value
                    auftrpos(1) = Sheets("Tabelle1").Cells(rZelle.Row, "C").Value
                    auftrpos(2) = Sheets("Tabelle1").Cells(rZelle.Row, "D").Value
                    auftrpos(3) = size
                    auftrpos(4) = amount
                    auftrpos(5) = Sheets("Tabelle1").Cells(rZelle.Row, "E").Value
                    auftrpos(6) = Sheets("Tabelle1").Cells(rZelle.Row, "S").Value
                    auftrpos(7) = Sheets("Tabelle1").Cells(rZelle.Row, "T").Value
                    auftrpos(8) = Sheets("Tabelle1").Cells(rZelle.Row, "U").Value
                    auftrpos(9) = Sheets("Tabelle1").Cells(rZelle.Row, "V").Value
                    auftrpos(10) = Sheets("Tabelle1").Cells(rZelle.Row, "W").Value
                    auftrpos(11) = Sheets("Tabelle1").Cells(rZelle.Row, "R").Value
                    
                    
                   'populating the second array
                    
                    auftrpos2 = Array(Sheets("Tabelle1").Cells(rZelle.Row, "A").Value, Sheets("Tabelle1").Cells(rZelle.Row, "C").Value, Sheets("Tabelle1").Cells(rZelle.Row, "D").Value, size, amount, Sheets("Tabelle1").Cells(rZelle.Row, "E").Value, Sheets("Tabelle1").Cells(rZelle.Row, "S").Value, Sheets("Tabelle1").Cells(rZelle.Row, "T").Value, Sheets("Tabelle1").Cells(rZelle.Row, "U").Value, Sheets("Tabelle1").Cells(rZelle.Row, "V").Value, auftrpos(10) = Sheets("Tabelle1").Cells(rZelle.Row, "W").Value, auftrpos(11) = Sheets("Tabelle1").Cells(rZelle.Row, "R").Value)
                    
                  
                    
                    With UserForm1.ListBox2
                        .ColumnCount = 12
                        
                        '.List = Application.Transpose(auftrpos2)
                        '.List = Application.Transpose(auftrpos)
                        '.List = auftrpos2
                        '.List = auftrpos
                    End With
                                
End Sub

我尝试以多种方式填充ListBox,但我总是得到行而不是列

1 个答案:

答案 0 :(得分:0)

好的,这就是诀窍^^ :)感谢您向我展示正确的道路! 但我还没有,当我想要添加第二个位置时,第一个条目被新的条目取代而不是被添加,怎么能实现这个呢?

&#13;
&#13;
Dim auftrpos4(0, 12) As String

                    auftrpos4(0, 0) = Sheets("Tabelle1").Cells(rZelle.Row, "A").Value
                    auftrpos4(0, 1) = Sheets("Tabelle1").Cells(rZelle.Row, "C").Value
                    auftrpos4(0, 2) = Sheets("Tabelle1").Cells(rZelle.Row, "D").Value
                    auftrpos4(0, 3) = size
                    auftrpos4(0, 4) = amount
                    auftrpos4(0, 5) = Sheets("Tabelle1").Cells(rZelle.Row, "E").Value
                    auftrpos4(0, 6) = Sheets("Tabelle1").Cells(rZelle.Row, "S").Value
                    auftrpos4(0, 7) = Sheets("Tabelle1").Cells(rZelle.Row, "T").Value
                    auftrpos4(0, 8) = Sheets("Tabelle1").Cells(rZelle.Row, "U").Value
                    auftrpos4(0, 9) = Sheets("Tabelle1").Cells(rZelle.Row, "V").Value
                    auftrpos4(0, 10) = Sheets("Tabelle1").Cells(rZelle.Row, "W").Value
                    auftrpos4(0, 11) = Sheets("Tabelle1").Cells(rZelle.Row, "R").Value
                    
With UserForm1.ListBox2
  .ColumnCount = 12
  .List = auftrpos4
End With
&#13;
&#13;
&#13;