Question

有大神能帮忙做一个VB窗口，数据来自已有的excel文件，我想在VB窗口输入人名确定后出现这一整行的数据

给个模板程序

Answer 1

'首先要将“工程－引用”中的Mic… Excel…选中
'在窗体上添加5个文本框（如果需要，可以再增多）和两个按钮
Dim StrTg As String
Dim xlApp As Excel.Application
Private Sub Command1_Click()
Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
On Error Resume Next
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open(App.Path & "\1.xls")
'打开存在数据的Excdl文件
If IntHs(Text1.Text) = 0 Then
MsgBox "没找到符合的记录！"
Else
Text2 = xlApp.Worksheets("Sheet1").Range("A1").Cells(IntHs(Text1.Text), 2)
Text3 = xlApp.Worksheets("Sheet1").Range("A1").Cells(IntHs(Text1.Text), 3)
Text4 = xlApp.Worksheets("Sheet1").Range("A1").Cells(IntHs(Text1.Text), 4)
Text5 = xlApp.Worksheets("Sheet1").Range("A1").Cells(IntHs(Text1.Text), 5)
End If
'xlBook.Save
'xlApp.Save
ActiveWorkbook.Close
xlBook.Close (True)
xlApp.Quit
Set xlApp = Nothing
End Sub
Private Function IntHs(StrYssj As String, Optional Mh As Integer) As Integer
Dim Czbj As Boolean
Dim StrT As String
Dim I As Integer
Mh = 0
I = 0
Czbj = False
Do While Czbj = False
I = I + 1
StrT = xlApp.Worksheets("Sheet1").Range("A1").Cells(I, 1)
If xlApp.Worksheets("Sheet1").Range("A1").Cells(I, 1) = StrYssj Then
IntHs = I
Czbj = True
ElseIf Trim(xlApp.Worksheets("Sheet1").Range("A1").Cells(I, 1)) = "" Then
IntHs = 0
Czbj = True
Mh = I - 1
End If
Loop
End Function
Private Sub Command2_Click()
Dim Zhhs As Integer
Dim Jlhs As Integer
Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
On Error Resume Next
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open(App.Path & "\1.xls")
Jlhs = IntHs(Text1.Text, Zhhs)
If Jlhs > 0 Then
xlApp.Worksheets("Sheet1").Range("A1").Cells(Jlhs, 2) = Text2
xlApp.Worksheets("Sheet1").Range("A1").Cells(Jlhs, 3) = Text3
xlApp.Worksheets("Sheet1").Range("A1").Cells(Jlhs, 4) = Text4
xlApp.Worksheets("Sheet1").Range("A1").Cells(Jlhs, 5) = Text5
MsgBox "修改成功！"
ElseIf Zhhs > 0 Then
Zhhs = Zhhs + 1
xlApp.Worksheets("Sheet1").Range("A1").Cells(Zhhs, 1) = Text1
xlApp.Worksheets("Sheet1").Range("A1").Cells(Zhhs, 2) = Text2
xlApp.Worksheets("Sheet1").Range("A1").Cells(Zhhs, 3) = Text3
xlApp.Worksheets("Sheet1").Range("A1").Cells(Zhhs, 4) = Text4
xlApp.Worksheets("Sheet1").Range("A1").Cells(Zhhs, 5) = Text5
MsgBox "新记录创建成功！"
End If
xlBook.Save
'xlApp.Save
ActiveWorkbook.Close
xlBook.Close (True)
xlApp.Quit
Set xlApp = Nothing
End Sub

Answer 2

我这简单，假设姓名在第一列
Private Sub Command1_Click()
Set oleExcel = CreateObject("Excel.Application")
oleExcel.Visible = False
oleExcel.Workbooks.Open ("c:\数据.xls")

a = InputBox("请输入姓名")

Do
hang = hang + 1
If oleExcel.Worksheets("Sheet1").Cells(hang, 1) = "" Then Exit Do
Loop

Do‘修改1，改变姓名所在列数
lie = lie + 1
If oleExcel.Worksheets("Sheet1").Cells(lie, 1) = "" Then Exit Do
z = oleExcel.Worksheets("Sheet1").Cells(lie, 1)
If z = a Then
For i = 1 To hang - 1
temp = temp & oleExcel.Worksheets("Sheet1").Cells(lie, i) & Space(1)
Next
MsgBox temp
Exit Do
End If
Loop

oleExcel.Quit
End Sub