Question

vb 如何提取excel中含有指定内容的行

查找excel中是否有text1里指定的内容，如果有就把excel中有的所有行提取出来另存为一excel文件,

Answer 1

Option Explicit
'Dim xlApp As Excel.Application '定义EXCEL类
'Dim xlBook As Excel.Workbook '定义工件簿类
'Dim xlsheet As Excel.Worksheet '定义工作表类

Dim xlApp As Object
Dim xlBook As Object
Dim xlsheet As Object
'Public Const sConnect = "ODBC;DSN=LocalServer;UID=sa;PWD=sa;Database=lgz;"

Dim db As Database
Dim qdef As QueryDef
Dim rs As Recordset
Dim qdef1 As QueryDef
Dim rs1 As Recordset
Dim rs2 As Recordset
'Dim sConnect As String

Dim i, temp0, J, SourceFile, DestinationFile, gg1, gg2, gg3, temp1, gg4

Private Sub Command1_Click()

temp1 = "2006技术保障维护维修情况上报表10月.xls"
SourceFile = "f:\sql\sblr\sblrbak.xls"
'DestinationFile = "f:\sql\sblr\sblr.xls"
DestinationFile = "f:\sql\sblr\" & Combo4.Text & "年技术保障维护维修情况上报表" & Mid(Combo5.Text, 1, 2) & "月到" & Mid(Combo7.Text, 1, 2) & "月.xls"
FileCopy SourceFile, DestinationFile

Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
xlApp.Visible = True '设置EXCEL可见
Set xlBook = xlApp.Workbooks.Open(DestinationFile) '打开EXCEL工作簿
Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlsheet.Activate '激活工作表
xlsheet.Cells(1, 1) = Combo4.Text & "年技术保障维护维修情况上报表" & Mid(Combo5.Text, 1, 2) & "月到" & Mid(Combo7.Text, 1, 2) & "月"
Adodc1.Recordset.MoveFirst
gg3 = 0
gg4 = 0
For i = 0 To Adodc1.Recordset.RecordCount - 1
gg1 = Trim(Combo4.Text) & "-" & Trim(Combo5.Text)
gg2 = Trim(Combo6.Text) & "-" & Trim(Combo7.Text)
If Trim(Adodc1.Recordset.Fields(1)) >= gg1 Then
If Trim(Adodc1.Recordset.Fields(1)) <= gg2 Then
gg3 = gg3 + 1
Text1.Text = gg3
For J = 1 To 11
gg4 = gg4 + CInt(Adodc1.Recordset.Fields(9))
temp0 = Trim(Adodc1.Recordset.Fields(J))
xlsheet.Cells(gg3 + 2, J) = temp0
Next J

End If
End If
Adodc1.Recordset.MoveNext
Next i
'xlsheet.Cells(gg3 + 4, 9) = gg4
xlsheet.Cells(gg3 + 4, 7) = "共计:" & gg3 & "件 合计:"
End Sub

Private Sub Command11_Click()

temp1 = "2006技术保障维护维修情况上报表10月.xls"
SourceFile = "f:\sql\sblr\sblrbak.xls"
'DestinationFile = "f:\sql\sblr\sblr.xls"
DestinationFile = "f:\sql\sblr\" & Combo4.Text & "nnn" & Mid(Combo5.Text, 1, 2) & "月.xls"
FileCopy SourceFile, DestinationFile

Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
xlApp.Visible = True '设置EXCEL可见
Set xlBook = xlApp.Workbooks.Open(DestinationFile) '打开EXCEL工作簿
Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlsheet.Activate '激活工作表

Adodc1.Recordset.MoveFirst
xlsheet.Cells(1, 1) = Combo4.Text & "nnn" & Mid(Combo5.Text, 1, 2) & "月"
gg3 = 0
gg4 = 0
For i = 0 To Adodc1.Recordset.RecordCount - 1
gg1 = Trim(Combo4.Text) & "-" & Trim(Combo5.Text)
gg2 = Trim(Combo6.Text) & "-" & Trim(Combo7.Text)
If Trim(Adodc1.Recordset.Fields(1)) >= gg1 Then
If Trim(Adodc1.Recordset.Fields(1)) <= gg2 Then
gg3 = gg3 + 1
Text1.Text = gg3
For J = 1 To 11
gg4 = gg4 + CInt(Adodc1.Recordset.Fields(9))
temp0 = Trim(Adodc1.Recordset.Fields(J))
xlsheet.Cells(gg3 + 2, J) = temp0
Next J

End If
End If
Adodc1.Recordset.MoveNext
Next i
'xlsheet.Cells(gg3 + 4, 9) = gg4
xlsheet.Cells(gg3 + 4, 7) = "共计:" & gg3 & "件 合计:"
End Sub
Private Sub Command3_Click()
Adodc1.Refresh
Adodc1.Recordset.Sort = (Combo1.Text)
End Sub

追问

你说的不是很懂唉，可不可以帮我把那上面的代码简化下呢，我没有分了，不然我会把分全部拿出来的

Answer 2

XLS的FIND可以满足你的要求：
xlSheet.Cells.Find(What:=stringToFind, lookin:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
PS:LookAt:=xlWhole全部匹配 ；xlPart模糊查找～

Answer 3

需要编一段程序，花点时间