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

Question

我希望你没事。

我有一个ID列，其中包含一些空白单元格，内部有空格，其他单元格包含信息，其中一些带有空格，而另一些带有#

目的是将TRIM功能应用于ID列并删除空白单元格和特殊字符。 Rm ：如果我尝试在应用修剪功能之前删除空白单元格，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

Answer 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

Answer 2

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