回复:关于那个程序
暂时的最终版本……(有很多缺陷)
Public conn
Dim dataArray()
Public recordCount, fieldCount As Integer
Public Sub UserForm_Initialize() '全局过程
Dim rs, cs, x, i
Set conn = CreateObject("ADODB.Connection") '创建 conn 对象
conn.Open "Driver={Microsoft Excel Driver (*.xls)};dbq=D:\KeyWord.xls" '连接 Excel 数据库
Set rs = conn.Execute("SELECT * FROM [Index$]") '选择 Excel 数据表
'Static counts
'Set cs = conn.Execute("SELECT COUNT(*) FROM [Index$]")
'counts = cs(0)
SheetsList.Clear '清除原来的列表内容
If Not rs.EOF Or Not rs.BOF Then
rs.MoveFirst
End If
While Not rs.EOF 'SheetsList 列表输出循环
x = rs(0)
If x <> "" And Not IsNull(x) Then
SheetsList.AddItem x
End If
rs.movenext
Wend
Set rs = Nothing '释放 rs 对象
End Sub
Public Function ReadData()
Dim rs, x
Dim row, col As Integer
Set rs = conn.Execute("SELECT COUNT(*) FROM [" & SheetsList.Text & "$]")
recordCount = rs(0)
Set rs = Nothing
Set rs = conn.Execute("SELECT * FROM [" & SheetsList.Text & "$]") '选择 Excel 数据表
If rs.EOF Then
fieldCount = 0
Else
fieldCount = rs.fields.Count
End If
ReDim dataArray(recordCount, fieldCount)
row = 0
While Not rs.EOF
For col = 0 To rs.fields.Count - 1
If IsNull(rs(col)) Then x = "" Else x = rs(col)
dataArray(row, col) = x
Next
row = row + 1
rs.movenext
Wend
End Function
Private Sub SheetsList_Change()
Dim rs, x, i
Set rs = conn.Execute("SELECT * FROM [" & SheetsList.Text & "$]") '选择 Excel 数据表
ListBox1.Clear '清除原来的列表内容
'If Not rs.EOF Or Not rs.BOF Then
' rs.MoveFirst
'End If
While Not rs.EOF 'ListBox1 列表输出循环
x = rs(0)
If x <> "" And Not IsNull(x) Then
ListBox1.AddItem x
End If
rs.movenext
Wend
Set rs = Nothing '释放 rs 对象
End Sub
Private Sub ListBox1_Click()
ListBox2.Clear '清除原来的列表内容
ReadData
Dim i, x, y As Integer
i = 0: x = -1
'If Not dataArray(0, 0) = "" And Not IsNull(dataArray(0, 0)) Then
While x <> ListBox1.ListIndex '寻找当前选择的对应行
If dataArray(i, 0) <> "" Then
x = x + 1
End If
i = i + 1
Wend
If i > 0 Then
y = i - 1
End If
TextBox1.Text = y
If dataArray(y, 1) <> "" Then
ListBox2.AddItem dataArray(y, 1)
End If
For i = y + 1 To recordCount
If dataArray(i, 0) = "" And dataArray(i, 1) <> "" Then
ListBox2.AddItem dataArray(i, 1)
End If
If dataArray(i, 0) <> "" Then
i = recordCount
End If
Next
'End If
End Sub
Private Sub ListBox2_Click()
ListBox3.Clear '清除原来的列表内容
ReadData
Dim i, x, y As Integer
i = 0: x = -1
While x <> ListBox2.ListIndex '寻找当前选择的对应行
If dataArray(i, 1) <> "" Then
x = x + 1
End If
i = i + 1
Wend
If i > 0 Then
y = i - 1
End If
TextBox1.Text = y
If dataArray(y, 2) <> "" Then
ListBox3.AddItem dataArray(y, 2)
End If
For i = y + 1 To recordCount
If dataArray(i, 1) = "" And dataArray(i, 2) <> "" Then
ListBox3.AddItem dataArray(i, 2)
End If
If dataArray(i, 1) <> "" Then
i = recordCount
End If
Next
End Sub
Private Sub ListBox3_Click()
ListBox4.Clear '清除原来的列表内容
ReadData
Dim i, x, y As Integer
i = 0: x = -1
While x <> ListBox3.ListIndex '寻找当前选择的对应行
If dataArray(i, 2) <> "" Then
x = x + 1
End If
i = i + 1
Wend
If i > 0 Then
y = i - 1
End If
TextBox1.Text = y
If dataArray(y, 3) <> "" Then
ListBox4.AddItem dataArray(y, 3)
End If
For i = y + 1 To recordCount
If dataArray(i, 2) = "" And dataArray(i, 3) <> "" Then
ListBox4.AddItem dataArray(i, 3)
End If
If dataArray(i, 2) <> "" Then
i = recordCount
End If
Next
End Sub
Private Sub CommandButton1_Click()
End
End Sub
Private Sub UserForm_Click()
End
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
conn.Close '关闭数据库连接
Set conn = Nothing '释放 conn 对象
End Sub