如何删除richtextbox中的所有空行?

[为防老年痴呆而编程]

如何编程实现删除richtextbox中的所有的空行?

[feiyun0112]

arr=split( richtextbox.text,vbcrlf)

for i=0 to ubound(arr)
if trim(arr(i)<>"" then
richtextbox.text= richtextbox.text & vbcrlf & arr(i)
endif
next

*****************************************************************************
欢迎使用CSDN论坛专用阅读器 : CSDN Reader(附全部源代码)

http://feiyun0112.cnblogs.com/

[skylinecn]

ss = Split(RichTextBox1.Text, vbCrLf)
If ss(0) = "" Then RichTextBox1.Text = Replace(RichTextBox1.Text, vbCrLf, "", 1, 1)
Do ' While 0 < InStr(RichTextBox1.Text, vbCrLf & vbCrLf)
RichTextBox1.Text = Replace(RichTextBox1.Text, vbCrLf & vbCrLf, vbCrLf)
Loop While 0 < InStr(RichTextBox1.Text, vbCrLf & vbCrLf)

当行数过多的时候，理论上讲这样执行效率高点吧。

[skylinecn]

[Quote=引用 2 楼 skylinecn 的回复:]
ss = Split(RichTextBox1.Text, vbCrLf)
If ss(0) = "" Then RichTextBox1.Text = Replace(RichTextBox1.Text, vbCrLf, "", 1, 1)
Do ' While 0 < InStr(RichTextBox1.Text, vbCrLf & vbCrLf)
RichTextBox1.Text = Replace(RichTextBox1.Text, vbCrLf & vbCrLf, vbCrLf)
Loop While 0 < InStr(RichTextBox1.Text, vbCrLf & vbCrLf)

当行数过多的时候，理论上讲这样执行效率高点吧。
[/Quote]

ss = Split(RichTextBox1.Text, vbCrLf)
If ss(0) = "" Then RichTextBox1.Text = Replace(RichTextBox1.Text, vbCrLf, "", 1, 1)
Do
DoEvents
RichTextBox1.Text = Replace(RichTextBox1.Text, vbCrLf & vbCrLf, vbCrLf)
Loop While 0 < InStr(RichTextBox1.Text, vbCrLf & vbCrLf)

[SYSSZ]

楼上的代码有问题,空行不一定就只有一个vbCrLf,还可能是很多空格后加上一个vbCrLf,一楼代码思路是对的,但实际使用时要稍作改动.
使用正则表达式也可

[SYSSZ]

一楼思路是对的.
三楼代码有问题,空行不一定只是一个回车换行符,还可以是许多空格加回车换行符.
正则表达式也行

[noenoughmemory]

不懂，up

[dlschan]

不懂，up

[skylinecn]

四楼、五楼说得对极了，确实没考虑到带空格的空行。

[SYSSZ]

'引用Microsoft VBScript Regular Expressions 5.5
Function StrReplace(s As String, p As String, r As String) As String
    
    Dim re As RegExp
    Set re = New RegExp
     re.IgnoreCase = True
     re.Global = True
     re.Pattern = p
     StrReplace = re.Replace(s, r)
    End Function
Private Sub Command1_Click()
    Dim s As String
    Dim p As String
    Dim r As String
     s = Trim(RichTextBox1.Text)
     p = "\r\n\s*\r\n"
     r = vbCrLf
     s = StrReplace(s, p, vbCrLf)
     RichTextBox1.Text = ""
    RichTextBox1.Text = s
   End Sub

可以试一试正则表达式,我测试通过了

[东方之珠]

用API吧:

Option Explicit
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SendMessageBynum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Const EM_GETLINECOUNT As Long = &HBA
Private Const EM_LINEINDEX As Long = &HBB
Private Const EM_LINELENGTH As Long = &HC1
Private Const EM_GETLINE As Long = &HC4

Private Sub Command1_Click()
        Dim GetLineCount As Long '返回富文本框行数
        Dim LineIndex As Integer '行号
        Dim GetLineText As String '取得行内容
        Dim lc As Long, linechar As Long
        'Dim Line As Integer
        Dim LineText() As String
        
        On Error Resume Next
        
        GetLineCount = SendMessage(RichTextBox1.hwnd, EM_GETLINECOUNT, 0, 0)
        ReDim LineText(GetLineCount - 1)
        'Debug.Print GetLineCount
        For LineIndex = 0 To GetLineCount - 1
            linechar = SendMessageBynum(RichTextBox1.hwnd, EM_LINEINDEX, LineIndex, 0)
            lc = SendMessageBynum(RichTextBox1.hwnd, EM_LINELENGTH, linechar, 0) + 1
            GetLineText = String$(lc + 2, 0)
            Mid$(GetLineText, 1, 1) = Chr(lc And &HFF)
            Mid$(GetLineText, 2, 1) = Chr(lc \ &H100)
            lc = SendMessageByString(RichTextBox1.hwnd, EM_GETLINE, LineIndex, GetLineText)
            GetLineText = Left(GetLineText, lc)
            LineText(LineIndex) = GetLineText
            'Debug.Print GetLineText
        Next
        
        RichTextBox1.Text = ""
        
        For LineIndex = 0 To GetLineCount - 1
            If Asc(LineText(LineIndex)) <> 32 Then
               RichTextBox1.Text = RichTextBox1.Text & LineText(LineIndex) & vbCrLf
            End If
        Next
        
End Sub

Private Sub Form_Load()
        RichTextBox1.Text = "       " & vbCrLf
        RichTextBox1.Text = RichTextBox1.Text & "dfdcvadv" & vbCrLf
        RichTextBox1.Text = RichTextBox1.Text & "   " & vbCrLf
        RichTextBox1.Text = RichTextBox1.Text & "sdfgsdfgsdfg" & vbCrLf
        RichTextBox1.Text = RichTextBox1.Text & "       " & vbCrLf
End Sub

[skylinecn]

张大哥的代码测试可行，但是首行空行无法处理。

自己加了两句解决了，还望张大哥赐教。

Function StrReplace(s As String, p As String, r As String) As String
Dim re As RegExp
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = p
StrReplace = re.Replace(s, r)
End Function

Private Sub Command1_Click()
Dim s As String
Dim p As String
Dim r As String
s = Trim(RichTextBox1.Text)
p = "\r\n\s*\r\n"
r = vbCrLf
s = StrReplace(s, p, vbCrLf)
RichTextBox1.Text = ""
RichTextBox1.Text = s

ss = Split(RichTextBox1.Text, vbCrLf)
If ss(0) = "" Then RichTextBox1.Text = Replace(RichTextBox1.Text, vbCrLf, "", 1, 1)
End Sub