Excel 从表单列表框中选择一个值并显示关联的值

我在a列有一个项目和说明的列表。第一个项目在第五行。每个项目后面都有项目说明

它看起来类似于以下内容（不同，但概念相同）：

我想做的是根据项目或描述将它们都放入2个数组中

我在这里做到了：

Option Explicit
Option Base 1

Sub main()

    Dim rngList As Range
    Dim strNetId As String
    Dim strListArray() As String

    Set rngList = Sheets("data").Range("A1").CurrentRegion

    Call CreateArray(rngList, strListArray())
    Call CreateArray2(rngList, strListArray())

End Sub

Sub CreateArray(rngIn As Range, strArray() As String)

    Dim iCols As Integer
    Dim iRows As Integer
    Dim iRowsH As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Counter As Integer
    Dim Counter2 As Integer
    Dim Count2 As Integer        

    iRows = (rngIn.Rows.Count - 1)
    iCols = 1
    iRowsH = (rngIn.Rows.Count - 1) / 2

    ReDim strArray(iRows, iCols)

    Count2 = 3
    Counter = 1

    Do
        If Count2 Mod 2 <> 0 Then
            strArray(Counter, 1) = rngIn.Cells(Count2 + 2, 1)
            Counter = Counter + 1
        End If
        Count2 = Count2 + 1
    Loop Until Count2 > iRows

End Sub

Sub CreateArray2(rngIn2 As Range, strArray2() As String)

    Dim iCols As Integer
    Dim iRows As Integer
    Dim iRowsH As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Counter As Integer
    Dim Counter2 As Integer
    Dim Count2 As Integer       

    iRows = (rngIn2.Rows.Count - 1)
    iCols = 1
    iRowsH = (rngIn2.Rows.Count - 1) / 2       

    ReDim strArray2(iRows, iCols)

    Count2 = 3
    Counter = 1

    Do
        If Count2 Mod 2 = 0 Then
            strArray2(Counter, 1) = rngIn2.Cells(Count2 + 2, 1)
            Counter = Counter + 1
        End If
        Count2 = Count2 + 1
    Loop Until Count2 > iRows

End Sub

---

我在哪里犯了第一个错误？我猜这与lblFirstName.Caption行代码有关。

我认为，您的代码可以简化，效率更高。请查看如何以稍微不同的方式构建和使用必要的阵列：

Private Sub testFillArrays()
 Dim sh As Worksheet, arr As Variant, arrN As Variant, arrD As Variant
 Dim n As Long, d As Long, i As Long, arrGlob() As Variant
   Set sh = ActiveSheet 'you will use Sheets("data")

   arr = sh.Range("A1").CurrentRegion.Value2 'base 1 array
   ReDim arrN(0 To UBound(arr, 2), 0 To Int(UBound(arr, 1) / 2)) '(0 based array)
   ReDim arrD(0 To UBound(arr, 2), 0 To Int(UBound(arr, 1) / 2))
   For i = 2 To UBound(arr)
        If i Mod 2 = 0 Then
            arrN(0, n) = arr(i, 1): n = n + 1 ' fruit names array
        Else
            arrD(0, d) = arr(i, 1): d = d + 1 ' fruit colors array
        End If
   Next i
   ReDim Preserve arrN(0 To 1, 0 To n - 1) 'clear the last empty element
   ReDim Preserve arrD(0 To 1, 0 To d - 1)

   'arrN is the array to be load in the list box.
   arrGlob = Array(arrN, arrD) 'define the array of arrays
   i = lstNetID.ListIndex 
   Debug.Print arrGlob(0)(0, i), arrGlob(1)(0, i) 'and press Ctrl + G to see the result...
End Sub

---

我认为你的代码可以简化，效率更高。请查看如何以稍微不同的方式构建和使用必要的阵列：

Private Sub testFillArrays()
 Dim sh As Worksheet, arr As Variant, arrN As Variant, arrD As Variant
 Dim n As Long, d As Long, i As Long, arrGlob() As Variant
   Set sh = ActiveSheet 'you will use Sheets("data")

   arr = sh.Range("A1").CurrentRegion.Value2 'base 1 array
   ReDim arrN(0 To UBound(arr, 2), 0 To Int(UBound(arr, 1) / 2)) '(0 based array)
   ReDim arrD(0 To UBound(arr, 2), 0 To Int(UBound(arr, 1) / 2))
   For i = 2 To UBound(arr)
        If i Mod 2 = 0 Then
            arrN(0, n) = arr(i, 1): n = n + 1 ' fruit names array
        Else
            arrD(0, d) = arr(i, 1): d = d + 1 ' fruit colors array
        End If
   Next i
   ReDim Preserve arrN(0 To 1, 0 To n - 1) 'clear the last empty element
   ReDim Preserve arrD(0 To 1, 0 To d - 1)

   'arrN is the array to be load in the list box.
   arrGlob = Array(arrN, arrD) 'define the array of arrays
   i = lstNetID.ListIndex 
   Debug.Print arrGlob(0)(0, i), arrGlob(1)(0, i) 'and press Ctrl + G to see the result...
End Sub

---

如图所示创建多列列表框，然后您可以使用

lstNetID.List（lstNetID.ListIndex，0）

和

lstNetID.List（lstNetID.ListIndex，1）

来检索值。您的列表框是否已填充？您使用的范围是否包含其他列，除了A:A？列表框中确实填充了项目，所有内容都在A列中。我只想在列表框中有1列的原因是，描述实际上非常长，不希望总是出现混乱。为了这篇文章，我简化了它。假设一盒谷物和成分列表作为描述。创建如图所示的多列列表框，然后您可以使用

lstNetID.list（lstNetID.ListIndex，0）

和

lstNetID.list（lstNetID.ListIndex，1）

来检索值。您的列表框是否已填充？您使用的范围是否包含其他列，除了A:A？列表框中确实填充了项目，所有内容都在A列中。我只想在列表框中有1列的原因是，描述实际上非常长，不希望总是出现混乱。为了这篇文章，我简化了它。想象一盒麦片和配料表作为描述。

Private Sub testFillArrays()
 Dim sh As Worksheet, arr As Variant, arrN As Variant, arrD As Variant
 Dim n As Long, d As Long, i As Long, arrGlob() As Variant
   Set sh = ActiveSheet 'you will use Sheets("data")

   arr = sh.Range("A1").CurrentRegion.Value2 'base 1 array
   ReDim arrN(0 To UBound(arr, 2), 0 To Int(UBound(arr, 1) / 2)) '(0 based array)
   ReDim arrD(0 To UBound(arr, 2), 0 To Int(UBound(arr, 1) / 2))
   For i = 2 To UBound(arr)
        If i Mod 2 = 0 Then
            arrN(0, n) = arr(i, 1): n = n + 1 ' fruit names array
        Else
            arrD(0, d) = arr(i, 1): d = d + 1 ' fruit colors array
        End If
   Next i
   ReDim Preserve arrN(0 To 1, 0 To n - 1) 'clear the last empty element
   ReDim Preserve arrD(0 To 1, 0 To d - 1)

   'arrN is the array to be load in the list box.
   arrGlob = Array(arrN, arrD) 'define the array of arrays
   i = lstNetID.ListIndex 
   Debug.Print arrGlob(0)(0, i), arrGlob(1)(0, i) 'and press Ctrl + G to see the result...
End Sub