如何從細胞空行在Excel（VBA）

Question

這裏就是我想通過包含字符串的所有單元格中的工作表來實現的，用有限的成功至今：

|示例|
cell1_empty_line
cell1_text1
cell1_empty_line
+ --------------------- +
cell2_text1
cell2_emptyline
cell2_text2
+ ---- ----------------- +
cell3_emptyline
cell3_emptyline
cell3_text1
+ -------------------- - +

|預期結果|
cell1_text1
+ --------------------- +
cell2_text1
cell2_text2
+ ------------- -------- +
cell3_text1
+ --------------------- +

不限於這樣一個宏建議？

非常感謝。

Answer 1

如果你是在談論一個給定的小區內的空行那麼這些人應該工作：

Cells.Replace什麼：= CHR（13），更換：= 「」，注視：= xlPart

Cells.Replace what：= Chr（10），Replacement：=「」，LookAt：= xlPart

Answer 2

這足以處理任何列的單元格，並且每個單元格中都有任何換行符。它假定所有的值都在列「A」開始活動工作表的第1行：

Public Function RemoveDoubleLfs(str As String) As String 
    If InStr(str, vbLf & vbLf) > 0 Then 
    str = RemoveDoubleLfs(Replace(str, vbLf & vbLf, vbLf)) 
    End If 
    RemoveDoubleLfs = str 
End Function 


Sub RemoveEmptyLines() 
    Dim i As Integer, lastRow As Integer 
    lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row ' 

    Dim val As String 
    For i = 1 To lastRow: 
    val = Cells(i, "A").Value 

    If InStr(1, val, vbLf) > 0 Then 
     val = RemoveDoubleLfs(val) 

     If Left(val, 1) = vbLf Then val = Right(val, Len(val) - 1) 
     If Right(val, 1) = vbLf Then val = Left(val, Len(val) - 1) 
     Cells(i, "A").Value = val 
    End If 
    Next 

    ActiveSheet.Rows.EntireRow.AutoFit 

End Sub 

遞歸替換功能擺脫了雙線的飼料中的單元格的文本。一旦完成，字符串的開頭和結尾最多隻有一個VbLf。最後兩條if語句查找並刪除後者。

最後的自動調整是可選的，純粹是爲了美化結果;它只是將細胞壓縮到最小高度。

Answer 3

使用此宏來刪除任何空行的所有單元格內：

Sub TrimEmptyLines() 
    Dim cel As Range, s As String, len1 As Long, len2 As Long 
    For Each cel In ActiveSheet.UsedRange 
     If Not IsError(cel.Value2) Then 
      If InStr(1, cel.text, vbLf) > 0 Then 
       s = Trim(cel.Value2) 
       Do ' remove duplicate vbLf 
        len1 = Len(s) 
        s = Replace$(s, vbLf & vbLf, vbLf) 
        len2 = Len(s) 
       Loop Until len2 = len1 

       ' remove vblf at beginning or at end 
       If Left$(s, 1) = vbLf Then s = Right$(s, Len(s) - 1) 
       If Right$(s, 1) = vbLf Then s = Left$(s, Len(s) - 1) 

       cel.value = Trim$(s) 
      End If 
     End If 
    Next 
End Sub 

Answer 4

使用這一解決方案，請在頂部設置了兩個變量的值之前。

FirstDataColumn = 1 
FirstDataRow = 2 

此設置將從第一列開始，但不包含可能包含列標題的第一行。

子RemoveBlanks（）

Dim FirstDataColumn As Long, FirstDataRow As Long 
Dim LastColumn As Long, LastRow As Long 
Dim Tmp As Variant, Arr As Variant 
Dim Counter As Integer 
Dim C As Long, R As Long 

FirstDataColumn = 1 
FirstDataRow = 2 

Application.ScreenUpdating = False 
With ActiveSheet 
    With .UsedRange 
     LastColumn = .Columns.Count 
     LastRow = .Rows.Count 
    End With 
    For C = FirstDataColumn To LastColumn 
     ReDim Arr(LastRow, 0) 
     Counter = 0 
     For R = FirstDataRow To LastRow 
      Tmp = Trim(.Cells(R, C).Value) 
      If Len(Tmp) Then 
       Arr(Counter, 0) = Tmp 
       Counter = Counter + 1 
      End If 
     Next R 
     .Cells(FirstDataRow, C).Resize(LastRow, 1).Value = Arr 
    Next C 
End With 
Application.ScreenUpdating = True 

結束子