VB6.0RichTextBox如何获取某行整行的内容

[dabusidexiaoqiang]

VB6.中使用RichTextBox读取某一Txt文件的内容，得到包含“ABC”的所有行：
Dim LineIndex As Long '行号
Dim strNo As Long '位置
rtb.Text = ts.ReadAll() 'rtb为RichTextBox实例
For strNo = 0 To Len(rtb.Text)
strNo = rtb.Find("ABC", nub, Len(rtb.Text))
strNo = rtb.GetLineFromChar(nub)
If strNo > 0 Then
LineIndex = strNo
'**********
'已得到行号，如何得到该行的内容？？？
'**********
Else
Exit For
End If
Next
/////////////////////////////////////
初衷是想得到Text文件中包含“ABC”的所有行，开始是一行一行读取并对比“ABC”，但Text文件较大，该方法效率不高，故欲寻求更好的方案，所以尝试使用优化度较高的RichTextBox控件，或者大家有更好的方案请不吝赐教~~谢谢!!

[孤独剑_LPZ]

思路:
将数据读入数组 sData(),按照回车键分割.
读行号8的数据,msgbox sData(7)

[贝隆]

超大的文本，也不会占用多少内存的。不信你可以计算一下。

[贝隆]

超大的文本，也不会占用多少内存的。不信你可以计算一下。

[dabusidexiaoqiang]

这个方法不可取，假设面对的是超大的text文件，这样会占用很大的内存，速度很慢，还有溢出的可能.....

[王二.麻子]

[Quote=引用 2 楼 的回复:]

这个方法不可取，假设面对的是超大的text文件，这样会占用很大的内存，速度很慢，还有溢出的可能.....
[/Quote]
你都For strNo = 0 To Len(rtb.Text)这样一个字符一个字符的循环查找了,还说效率?
...
先找到需要查找的字符串,用find方法,得到结果A
然后从A开始查找回车,用find(vbcrlf,A),得到A所在行的结束位置B,

在B设置选择点crlf
给richtextbox发送按键信息ctrl+shift+Left,这样会吧插入点移动到上一个vbcrlf的位置,并且从位置B往前到现在插入点都被选中了,
然后用seltext属性,就得到这个行了

没必要用GetLineFromChar
我的测试代码:
发送ctrl+left,ctrl+shift+right后不会马上在seltext属性有反应,所以我用了延迟,timer1的延迟是20,嘿

Option Explicit

Private Sub Command1_Click()
Dim P1 As Long
With RichTextBox1
        .SelStart = .Find("YYYWWW")
        .SelLength = 0
        .SetFocus
        SendKeys "^{left}", False
        SendKeys "+^{right}", False
End With
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
With RichTextBox1
        Debug.Print Timer, .SelText, .SelStart, .SelLength
End With
End Sub

Private Sub Form_Load()
With RichTextBox1
        .Text = "1111111111111111111111111111111111111111111111111111" & vbCrLf & _
        "2111111111111111111111111111111111111111111111111111" & vbCrLf & _
        "3111111111111111111111111111111111111111111111111111" & vbCrLf & _
        "411111111111111111111111111111YYYWWW1111111111111111111111" & vbCrLf & _
        "5111111111111111111111111111111111111111111111111111" & vbCrLf & _
        "6111111111111111111111111111111111111111111111111111" & vbCrLf & _
        "71111111111111111111111111111111111111111111111" & vbCrLf
        
End With
End Sub

Private Sub Timer1_Timer()
If RichTextBox1.SelText <> "" Then Label1.Caption = Timer & " " & RichTextBox1.SelText
Timer1.Enabled = False
End Sub

[dabusidexiaoqiang]

'//某文件夹中所有txt中的所有包含“ABCDEF”的行
最好的方法还是text行历遍用Instr找出后插入另一个text中：
Private Sub CheckIntoText()

Dim fs As New Scripting.FileSystemObject
Dim fss As New Scripting.FileSystemObject
Dim ts As TextStream
Dim tss As TextStream
Dim strline As String
Dim strtop50 As String

Dim paths As String
Dim files, filenames(1 To 20) As String
Dim filenub As Long
Dim i, j As Long 'i第几文件，j读取了几行

i = 1
j = 1

paths = txtPath.Text
files = Dir(paths)


List1.Clear
usetime1 = Timer

Do While files <> ""
If LCase(Right(files, 3)) = "txt" Then '后缀为txt
filenames(i) = files
List1.AddItem (filenames(i))
i = i + 1
filenub = filenub + 1
End If
files = Dir
Loop

For i = 1 To filenub

List1.Selected(i - 1) = True
files = paths & filenames(i)
Set ts = fs.OpenTextFile(files, ForReading, False)

j = 1

Do While ts.AtEndOfStream = False

strline = ts.ReadLine()

If checkstr(Left(strline, 50)) = True Then
If j = 1 Then
Set tss = fss.CreateTextFile(App.path & Format(DateTime.Now, "\\yyyyMMdd\\") & filenames(i), True)
End If

tss.WriteLine (strline)
j = j + 1

End If

Loop

If Not tss Is Nothing Then
tss.Close
Set tss = Nothing
End If
Next

End Sub

Private Function checkstr(ByVal str As String) As Boolean
If Len(str) > 9 Then '去除短行或空行
If InStr(1, str, "ABCDEF", vbTextCompare) > 0 Then
checkstr = True
Exit Function
Else
checkstr = False
Exit Function
End If
Else
checkstr = False
Exit Function
End If
End Function

插入到Excel中的话会慢很多，大概是内存调用花时间多了点：
Private Function CheckIntoExcel() As Boolean

Dim fs As New Scripting.FileSystemObject
Dim ts As TextStream
Dim strline As String
Dim strtop50 As String

Dim paths As String
Dim files, filenames(1 To 20) As String
Dim filenub As Long
Dim i, j As Long 'i第几文件，j读取了几行
Dim isnewsheet As Boolean '是否要新建sheet
Dim nextsheet As Long '下一个sheet号
Dim isnextsheet As Boolean '是否要进入下一个sheet号，即有无找出数据

Dim xlapp As Excel.Application 'Excel对象
Dim xlbook As Excel.Workbook '工作簿
Dim xlsheet As Excel.Worksheet '工作表

i = 1
j = 1
nextsheet = 1
isnewsheet = True
isnextsheet = False

paths = txtPath.Text
files = Dir(paths)

Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlbook = xlapp.Workbooks.Add '新建EXCEL工件簿文件
xlapp.Visible = False '设置EXCEL对象可见（或不可见）

List1.Clear
usetime1 = Timer

Do While files <> ""
If LCase(Right(files, 3)) = "txt" Then '后缀为txt
filenames(i) = files
List1.AddItem (filenames(i))
i = i + 1
filenub = filenub + 1
End If
files = Dir
Loop

For i = 1 To filenub

List1.Selected(i - 1) = True
files = paths & filenames(i)
Set ts = fs.OpenTextFile(files, ForReading, False)

j = 1
isnewsheet = True
isnextsheet = False

Do While ts.AtEndOfStream = False

strline = ts.ReadLine()

If checkstr(Left(strline, 50)) = True Then
isnextsheet = True
If nextsheet < 4 Then
Set xlsheet = xlbook.Worksheets(nextsheet)
Else
If isnewsheet = True Then
Set xlsheet = xlapp.Application.Worksheets.Add(After:=xlapp.ActiveSheet)
isnewsheet = False
Else
On Error GoTo ERR:
Set xlsheet = xlbook.Worksheets(nextsheet)
End If
End If

If j = 1 Then
xlsheet.Activate
xlsheet.Name = filenames(i)
End If

xlsheet.Cells(j, 1).Value = strline
j = j + 1

End If

Loop

If isnextsheet = True Then
nextsheet = nextsheet + 1
End If


Next
usetime1 = Timer - usetime1

If Not xlsheet Is Nothing Then
usetime2 = Timer
xlsheet.SaveAs App.path & "/test" & Format(DateTime.Time, "HHmmss") & ".xls" '按指定文件名存盘
usetime2 = Timer - usetime2
End If
xlapp.Quit '结束EXCEL对象'xlapp.Workbooks.Close
Set xlapp = Nothing '释放xlApp对象
Check = True
Exit Function

ERR:
If Not xlsheet Is Nothing Then
usetime2 = Timer
xlsheet.SaveAs App.path & "/test" & Format(DateTime.Time, "HHmmss") & ".xls" '按指定文件名存盘
usetime2 = Timer - usetime2
End If
xlapp.Quit '结束EXCEL对象'xlapp.Workbooks.Close
Set xlapp = Nothing '释放xlApp对象
Check = False
Exit Function

End Function