在整列中应用修剪功能后,删除空白单元格和包含特殊字符的单元格为#

时间:2018-07-08 13:59:53

标签: vba excel-vba excel

我希望你没事。

我有一个ID列,其中包含一些内部有空格的空白单元格以及其他具有信息的单元格,其中一些具有空格,另一些具有#

目标是将TRIM功能应用于ID列,并删除空白单元格和特殊字符。 Rm:如果我尝试在应用Trim功能之前删除空白单元格,则VBA不会将其识别为空单元格。但是即使应用了“修剪”功能后,仍然不能将它们识别为空单元格。与#相同的故事 因此,我尝试制作TRIM函数,然后仅复制带有值的粘贴列以删除TRIM函数,以防万一。但是同样的问题。坦克为您提供帮助

这是代码

    Sub Trim()

 Dim Worksht As Worksheet
 Dim TargetCell As Range
 Dim DurtyRows As Range


 Set Worksht = ActiveSheet

 Set TargetCell = ActiveSheet.UsedRAnge.Find(What:="ID", LookAt:=xlWhole)

 Range(TargetCell.Offset(1, 0), TargetCell.Offset(1, 0).End(xlDown)).Copy
 TargetCell.Offset(1, 1).Select
 'To Apply TRIM Function in an copied column 
 ActiveSheet.Paste
 Application.CutCopyMode = False
 TargetCell.Offset(1, 1).Select

 ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"

 Selection.AutoFill Destination:=Range(TargetCell.Offset(1, 1), 
 TargetCell.Offset(1, 1).End(xlDown))

 'Replacing the initial Column with  TRIM Function Result Column

 Range(TargetCell.Offset(1, 1), TargetCell.Offset(1, 1).End(xlDown)).Copy

 TargetCell.Offset(1, 0).Select

 Selection.PasteSpecial Paste:=xlPasteValues

 Application.CutCopyMode = False

 Range(TargetCell.Offset(1, 1), TargetCell.Offset(1, 1).End(xlDown)).Delete

 Range(TargetCell.Offset(1, 0), TargetCell.Offset(1, 0).End(xlDown)).Select

 ''''the error message for.SpecialCells (xlCellTypeBlanks) " no corresponding  
 ''cell

 Set DurtyRows = ActiveSheet.Range(TargetCell.Offset(1, 0), TargetCell.Offset(1, 0).End(xlDown)).SpecialCells(xlCellTypeBlanks)

 DurtyRows.Delete

 End Sub

2 个答案:

答案 0 :(得分:1)

在使用空字符串替换#后,尝试使用“文本到列”将单元格“修剪”为真正的空白单元格。

with worksheets("sheet1")
    with .range(.cells(2, "B"), .cells(.rows.count, "B").end(xlup))
        .replace what:=chr(35), replacement:=vbnullstring
        .texttocolumns  Destination:=.cells(1), _
                        DataType:=xlFixedWidth,  FieldInfo:=Array(0, 1)
        .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    end with
end with

答案 1 :(得分:1)

With Worksheets("trim")
    With .Range(TargetCell.Offset(1, 0), TargetCell.Offset(1, 0).End(xlDown))
    .TextToColumns Destination:=.Cells(1), _
                        DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
        .Replace what:=Chr(35), replacement:=vbNullString
        .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    End With
End With