Question

vb txt excel

逐行读取txt文本，然后查找我要找的字符串，如果有，读取该行该字符串后的内容，并写入excel，如果没有接着读取下一行，注意：文本中有空行
先给50，写成后在加100，谢谢

Answer 1

顺序读取文本每行的代码示例
Dim i As Integer
Dim str() As String
Dim flg As Boolean
Dim tmpString As String

’读取文本中的每一行
Open App.Path + "\A.txt" For Input As #1
Do While Not EOF(1)
i = i + 1
ReDim Preserve str(i)
Line Input #1, str(i)
Loop
Close #1

' 使用InStr函数判断是否有需要查找的字符串
For i = 0 To UBound(str)
If InStr(1, str(i), txtStr.Text) > 0 Then
flg = True
End If

If flg And i < UBound(str) Then
tmpString = tmpString + str(i + 1)
End If
Next i

VB写入Excel的方法
Private Sub Command1_Click()
Dim xlExcel As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim AppExcel As Object
Dim str As String
str = App.Path & "\11.xls"

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False '设置excel对象不可见
Dim objWorkBook As Excel.Workbook
objExcel.SheetsInNewWorkbook = 1
Set objWorkBook = objExcel.Workbooks.Add
objExcel.Cells(3,4) = Text1.Text
objWorkBook.SaveAs str
objWorkBook.Close (True)
objExcel.Quit
Set objExcel = Nothing
End Sub

Answer 2

添加引用调用Excel控件
菜单->Project->references添加->Microsoft Excel 11.0 Object library

Public Function FindTxt(ByVal findStr As String) As Boolean

Dim FileNo As Integer, i As Integer
Dim Content As String, fileName As String
Dim objExcelApp As Excel.Application
Dim objSheet As Excel.Worksheet

Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Workbooks.Open App.Path & "\template.xls", , True
objExcelApp.Visible = False
objExcelApp.DisplayAlerts = False

Set objSheet = objExcelApp.ActiveWorkbook.Sheets("Sheet1")

fileName = Dir$(App.Path & "\11.txt", vbNormal)
If fileName = "" Then Exit Function

FileNo = FreeFile
Open App.Path & "\" & fileName For Input As FileNo

i = 1
Do Until EOF(FileNo)

Line Input #FileNo, Content
If InStr(findStr, Content) > 0 Then
Line Input #FileNo, Content
If Content <> "" Then
objSheet.Cells(i, 1).Value = Content
i = i + 1
End If
End If

Loop

Close #FileNo

objExcelApp.Workbooks(1).SaveAs App.Path & "\res.xls"
objExcelApp.ActiveWorkbook.Close
objExcelApp.Quit
Set objExcelApp = Nothing

End Function

Answer 3

菜单->工程->引用添加->Microsoft Excel 11.0 Object library
Private Sub Command1_Click()
Dim objExcelApp As Excel.Application
Dim objSheet As Excel.Worksheet
Dim strTmp, i

Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Workbooks.Open App.Path & "\test.xls"
'objExcelApp.Visible = False
'objExcelApp.DisplayAlerts = False

Set objSheet = objExcelApp.ActiveWorkbook.Sheets("Sheet1")
Open App.Path + "\1.txt" For Input As #1
i = 1
Do While Not EOF(1)
Line Input #1, strTmp
If Trim(strTmp) <> "" Then
objSheet.Cells(i, 1) = strTmp
i = i + 1
End If
Loop
Close #1

objExcelApp.Save
objExcelApp.Quit
Set objSheet = Nothing
Set objExcelApp = Nothing
MsgBox "OK"
End Sub

子易空间站 - Excel培训专家

Answer 4

MARK