Question

我有一个宏，它在换行时用多行数据分割单元格，它运行顺畅。然而，我碰到了一个凸起，宏在分裂时会留下一些空白单元格。我有一些代码来识别空白单元格并删除它们，但不知何故它不起作用。所以我想知道我是否将测试空白代码放在正确的位置？它们似乎是用于检查空白代码的正确代码。

这是我的代码：

Sub SplitMultipleHostnames()
Dim tmpArr As Variant


For Each cell In Range("D2", Range("D3").End(xlDown))
If cell <> "" Then
    If InStr(1, cell, Chr(10)) <> 0 Then
        tmpArr = Split(cell, Chr(10))

        cell.EntireRow.Copy

        cell.Offset(1, 0).Resize(UBound(tmpArr), 1).EntireRow.Insert xlShiftDown



        cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)


    End If
Else
    cell.EntireRow.Delete
End If
Next
Application.CutCopyMode = False


End Sub

这是示例的打印屏幕，通常主机名和IP地址将逐行显示，但如果在它们之间有一个空行，则它将被拆分为空白单元格。空白单元将阻止整个循环工作。

编辑：注意到代码运行时会创建一些空白单元格。

Answer 1

如前面的评论所提出的那样，单元格可能并非空洞。你确认这些细胞真的是空的吗？

If Replace(Replace(Trim(cell.value2), chr(10), ""), vbNewLine, "") <> vbNullString Then

Answer 2

试试这段代码。我已经评论过它来解释我在做什么，但是如果你需要进一步细分它是如何工作的，请告诉我。我添加了错误处理来处理预期和意外情况。

编辑：我添加了一个清除从分割/转置循环中的并发分隔符创建的单元格的函数，并将删除空行步骤移到do循环后执行清理这些操作。

Sub SplitMultipleHostnames()
    'I've added some error handling. 
    On Error GoTo UnexpectedErr

    'Get the last used cell.
    With Range("D:D")
        Dim LastDataCell As Range
        Set LastDataCell = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False, False, False)
    End With

    'We need to have some data to work upon beyond the first row
    If LastDataCell Is Nothing Then Exit Sub
    If LastDataCell.Row < 2 Then Exit Sub

    'I set a range variable here to make it easier to work with later
    Dim WorkingRange As Range
    Set WorkingRange = Range("D2", LastDataCell)

    'You can avoid expensive loop overhead by just finding the cells containing _
    the character you wish to split upon, and acting upon only these cells
    Dim FoundCell As Range
    Dim FirstAddress As String
    Set FoundCell = WorkingRange.Find(Chr(10), LastDataCell, xlValues, xlPart, xlByRows, xlNext, False, False, False)

    'Another benefit of this approach: if there are no line breaks we can exit early
    If FoundCell Is Nothing Then Exit Sub

    'We are going to use .FindNext to loop through all the cells containing our _
    delmiiter character.  Store first found cell's address so we know when we're done
    FirstAddress = FoundCell.Address

    'Since we know our data type we should declare are variable as such
    Dim tmpArr() As String
    Do
        tmpArr = Split(FoundCell, Chr(10))
        'Use a With block if you're lazy like me ;)
        With FoundCell
            .Offset(1, 0).Resize(UBound(tmpArr), 1).EntireRow.Insert xlShiftDown
            Set FoundCell = FoundCell.Resize(UBound(tmpArr) + 1, 1)
            FoundCell = Application.Transpose(tmpArr)
        End With

        'A cell could contain mulitple concurrent delimiters.
        'We can handle this by finding all concurrent delimiters and replacing with a _
        single delimiter before splitting the cell contents.
        ' - OR -
        'We can split the cell contents and then remove any remaining delimiters afterward

        'I've elected to do the latter as I think it's the simplest route in this application
        Dim CheckCell As Range
        For Each CheckCell In FoundCell
            RemoveDelimiters CheckCell, Chr(10), True
        Next

        'Find the next cell to work upon
        Set FoundCell = WorkingRange.FindNext
        'If we don't find another match, we are done
        If FoundCell Is Nothing Then Exit Do
    Loop While FoundCell.Address <> FirstAddress

    'Now that we are done, we will delete any rows with blank cells
    Dim BlankCells As Range

    'It is possible there are not any empty cells - we should anticipate this error and provide a way to handle it:
    On Error GoTo CatchErr001
    Set BlankCells = WorkingRange.SpecialCells(xlCellTypeBlanks)
    On Error GoTo UnexpectedErr

    'We check condition to see if BlankCells is allocated, as we know it won't be if no blank cells were found
    If Not BlankCells Is Nothing Then BlankCells.EntireRow.Delete

Exit Sub

CatchErr001:
    '1004 is a generic runtime error. It could be because no blank cells found, or something else.
    'If it's due to no blank cells our code is built to deal with this condition so we can safely swallow the error
    If (err.Number = 1004) And (InStr(1, err.Description, "No cells were found", vbTextCompare) > 0) Then
        Resume Next
    'If it's due to something else, our program is in an unknonw state.  This is unexpected
    Else
        GoTo UnexpectedErr
    End If

UnexpectedErr:
    Dim CaughtErr As ErrObject
    Set CaughtErr = err
    On Error GoTo 0
    err.Raise CaughtErr.Number, CaughtErr.Source, CaughtErr.Description, CaughtErr.HelpFile, CaughtErr.HelpContext
End Sub

Private Sub RemoveDelimiters(ByRef CheckCell As Range, ByRef Delimiter As String, Optional ByVal RemoveSpaces As Boolean = False)
    Dim CheckValue As String
    CheckValue = CheckCell.value
    'If the cell is already empty we don't do anything further
    If Len(CheckCell) <= 0 Then Exit Sub
    'Remove spaces if the calling procedure specified to do so
    If RemoveSpaces Then CheckValue = Trim(CheckValue)
    'Remove all delimiter characters
    CheckValue = Replace(CheckCell, Delimiter, "")
    'Replace the cell's value with our modified value
    CheckCell.value = CheckValue
End Sub

在换行符处拆分单元格，其中包含VBA中的内容

2 个答案: