|
Listbox和数组的综合练习
（注意，主要是方便新手学习，高手莫笑，若进来看了，请指出错误之处，并请解答我提的动态更改二维数组的问题！）
以下代码，均能在附件中找到。
实例:
假定SHEET1中有3列数据.
1\ LISTBOX 加载数据方法
l 首先定义以下两项
ListBox1.ColumnCount = 3 '设为3列
ListBox1.ColumnWidths = "30;30;30" '两列的宽度分别为30磅,经测试该处用”,”号分隔也可以.
如果要加载的内容为固定区域
方法1:利用RowSource属性
Private Sub UserForm_Initialize()
Dim rng ‘若要用变量,注意该该处不能定义为RANGE
rng = "sheet2!a1:c19"
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ColumnWidths = "30,30,30"
Me.ListBox1.ListStyle = fmListStyleOption
Me.ListBox1.SpecialEffect = 0
Me.ListBox1.RowSource = rng ‘此处也可不用变量直接用"sheet2!a1:c19"
End Sub
方法2:利用List属性
Private Sub UserForm_Initialize()
Dim rng ‘注意该该处不能定义为RANGE
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ColumnWidths = "30,30,30"
rng = Sheet1.Range("a1:c19")
Me.ListBox1.List = rng ‘必须用变量,不能直接Sheet1.Range("a1:c19")
End Sub
方法3:用于固定区域,这个麻烦点,一般无须用这,先说明用数组是为了练习
Private Sub UserForm_Initialize()
Dim rng As Range, i%
Dim arr(1 To 19, 1 To 3)
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ColumnWidths = "30,30,30"
Set rng = Range("a1:c10")
For i = 1 To 19
arr(i, 1) = rng(i, 1)
arr(i, 2) = rng(i, 2)
arr(i, 3) = rng(i, 3)
Next
Me.ListBox1.List() = arr
End Sub
‘注意点:List属性不能直接加载RANGE数据区域,但可加载数组.
如果要加载的内容为非固定区域
事例1:若要加载数据区域时
Private Sub UserForm_Initialize1()
Dim rng As Range, i%
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ColumnWidths = "30,30,30"
Set rng = Range("a1:c19")
For i = 0 To 18
Me.ListBox1.AddItem rng(i + 1, 1) ‘此处必须先用AddItem加载,不可用Me.ListBox1.List(i, 0) = rng(i + 1, 1)代替
Me.ListBox1.AddItem rng(i + 1, 1)
Me.ListBox1.List(i, 1) = rng(i + 1, 2)
Me.ListBox1.List(i, 2) = rng(i + 1, 3)
Next i
End Sub
Private Sub UserForm_Initialize() ,数组练习,使用一维数组转化
Dim rng As Range, i%
Dim arr1(19), arr2(19), arr3(19)
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ColumnWidths = "30,30,30"
For i = 0 To 18
arr1(i) = Range("a" & i + 1)
arr2(i) = Range("b" & i + 1)
arr3(i) = Range("c" & i + 1)
Me.ListBox1.AddItem arr1(i)
Me.ListBox1.List(i, 1) = arr2(i)
Me.ListBox1.List(i, 2) = arr3(i)
Next i
End Sub
事例2:将Listbox的数据列互相置换,此处使用帮助文件,方便大家对照学习
Dim MyArray(6, 3)
'数组含有列表框的列值。
Private Sub UserForm_Initialize()
Dim i As Single
ListBox1.ColumnCount = 3
'这个列表框包含三个数据列
'加载整数值 MyArray
For i = 0 To 5
MyArray(i, 0) = i
MyArray(i, 1) = Rnd
MyArray(i, 2) = Rnd
Next i
'加载 ListBox1
ListBox1.List() = MyArray
End Sub
Private Sub CommandButton1_Click()
'交换 1 列和 3 列的内容
Dim i As Single
Dim Temp As Single
For i = 0 To 5
Temp = ListBox1.List(i, 0)
ListBox1.List(i, 0) = ListBox1.List(i, 2)
ListBox1.List(i, 2) = Temp
Next i
End Sub
‘注意点:在Listbox没有加载任何数据之前, List(X,Y)处于不可用.
事例3:分项加载,如与FIND联合应用,将a1:a100为7的行加载到ListBox1中
Option Explicit
方法1:
Private Sub CommandButton1_Click()
Dim rng As Range
Dim arr, first, i%
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ForeColor = &HFF8080
Set rng = Range("a1:a100").Find(what:=7, lookat:=xlWhole)
If Not rng Is Nothing Then
first = rng.Address
End If
i = 0
Do
Me.ListBox1.AddItem rng.Range("a1")
Me.ListBox1.List(i, 1) = rng.Range("b1")
Me.ListBox1.List(i, 2) = rng.Range("c1")
Set rng = Range("a1:a100").FindNext(rng)
i = i + 1
Loop While Not rng Is Nothing And rng.Address <> first
End Sub
方法2:
Private Sub CommandButton2_Click()
Dim rng As Range
Dim arr(), arr1(), arr2(), first, i%
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ForeColor = &HC0C0&
Set rng = Range("a1:a100").Find(what:="7", lookat:=xlWhole)
If Not rng Is Nothing Then
first = rng.Address
End If
i = 0
ReDim arr(i)
ReDim arr1(i)
ReDim arr2(i)
Do
arr(i) = rng.Range("a1")
arr1(i) = rng.Range("b1")
arr2(i) = rng.Range("c1")
Set rng = Range("a1:a100").FindNext(rng)
Me.ListBox1.AddItem arr(i)
Me.ListBox1.List(i, 1) = arr1(i)
Me.ListBox1.List(i, 2) = arr2(i)
i = i + 1
ReDim Preserve arr(i)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
Loop While Not rng Is Nothing And rng.Address <> first
End Sub
方法3:
Private Sub CommandButton3_Click()
Dim rng As Range
Dim arr(), arr1(), arr2(), arr3(), first, i%, r%
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ForeColor = &HFFFF80
Set rng = Range("a1:a100").Find(what:="7", lookat:=xlWhole)
If Not rng Is Nothing Then
first = rng.Address
End If
i = 1
ReDim arr(i)
ReDim arr1(i)
ReDim arr2(i)
Do
arr(i) = rng.Range("a1")
arr1(i) = rng.Range("b1")
arr2(i) = rng.Range("c1")
Set rng = Range("a1:a100").FindNext(rng)
i = i + 1
ReDim Preserve arr(i)
ReDim Preserve arr1(i)
ReDim Preserve arr2(i)
Loop While Not rng Is Nothing And rng.Address <> first
ReDim arr3(1 To UBound(arr) - 1, 1 To 3)
'Debug.Print UBound(arr) - 1
For r = 1 To UBound(arr) - 1
arr3(r, 1) = arr(r)
arr3(r, 2) = arr1(r)
arr3(r, 3) = arr2(r)
Next
Me.ListBox1.List() = arr3()
End Sub
方法4:
Private Sub CommandButton4_Click()
Dim rng As Range
Dim arr(), first, i%, r%
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ForeColor = &HFF00FF
r = Application.WorksheetFunction.CountIf(Range("a1:a100"), "7")
'Debug.Print r
Set rng = Range("a1:a100").Find(what:="7", lookat:=xlWhole)
If Not rng Is Nothing Then
first = rng.Address
End If
i = 1
ReDim arr(i To r, 1 To 3)
Do
arr(i, 1) = rng.Range("a1")
arr(i, 2) = rng.Range("b1")
arr(i, 3) = rng.Range("c1")
Set rng = Range("a1:a100").FindNext(rng)
i = i + 1
Loop While Not rng Is Nothing And rng.Address <> first
Me.ListBox1.List() = arr
End Sub
‘注意点:当用ReDim Preserve时,方便用于一维数组,用于二维或多维数组时,只能更改最末维,所以方法3中,没有想到办法使用一个数组.
,下面代码无法运行,因为数组无法动态改变:
Private Sub CommandButton2_Click()
Dim rng As Range
Dim arr(), arr1(), arr2(), first, i%
Me.ListBox1.Clear
Me.ListBox1.ColumnCount = 3
Me.ListBox1.ForeColor = &HC0C0&
Set rng = Range("a1:a100").Find(what:="7", lookat:=xlWhole)
If Not rng Is Nothing Then
first = rng.Address
End If
i = 0
ReDim arr(i, 2)
Do
arr(i, 0) = rng.Range("a1")
arr(i, 1) = rng.Range("b1")
arr(i, 2) = rng.Range("c1")
Set rng = Range("a1:a100").FindNext(rng)
i = i + 1
ReDim Preserve arr(i, 2) ‘该处出错,不知哪位朋友有办法能解决
Loop While Not rng Is Nothing And rng.Address <> first
Me.ListBox1.List() = arr
End Sub
Surb0mhZ.rar
(34.56 KB, 下载次数: 344)
[此贴子已经被作者于2006-8-4 18:33:15编辑过] |
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2006-6-14 19:30
楼主
