我希望你没事。
我有一个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
答案 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