宏不会删除所有空白单元格

时间:2012-10-30 16:57:23

标签: excel excel-vba excel-2010 vba

这是一个冗长的查询,因为我包含失败的代码。

问题:当我将文本文件导入excel时,我的工作表包含许多“空白”单元格。我在其他地方之前已经成功使用了以下代码,但在这种情况下它并不适合我。

Range("b1:AZ60").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete shift:=xlToLeft

我在网上搜索并找到了一些建议的解决方案(如下)。我尝试在上面的代码之前运行下面的4个snipets代码中的每一个以清除所谓的空白单元格的内容但到目前为止没有任何工作。

Number 1 --------------------------------------------- ------------

 Set rng = Intersect(Selection, Selection.Parent.UsedRange)

For Each C In rng
   If Trim(C) = "" Then
   C.ClearContents
   End If
Next C

我用c.value替换了上面的修剪但没有

If C.Value <> "" Then

Number 2 --------------------------------------------- -----

For Each aCell In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
    If Not aCell.Value Like "*[! ]*" Then aCell.ClearContents
Next

Number 3 --------------------------------------------- ----

For Each C In rng
   If IsEmpty(C) Then
   C.Delete shift:=xlToLeft
   Else
   ActiveCell.Select
   End If
Next C

Number 4 --------------------------------------

最后我发现了这个干净的功能,但这似乎并没有成功。

Set rng = Intersect(Selection, Selection.Parent.UsedRange)

For Each C In rng
    If Not IsError(C) Then
        C.Value = MEGACLEAN(C)
    End If
Next C
              '
              '
              '
End Sub
-----------------------------------------
Function MEGACLEAN(varVal As Variant)
Dim NewVal As Variant
If IsMissing(varVal) Then Exit Function
NewVal = Trim(varVal) 'remove spaces
NewVal = Application.WorksheetFunction.Clean(NewVal) 'remove most unwanted characters
NewVal = Application.WorksheetFunction.Substitute(NewVal, Chr(127), "") 'remove   
ASCII#127
NewVal = Application.WorksheetFunction.Substitute(NewVal, Chr(160), "") 'remove  
ASCII#160
MEGACLEAN = NewVal
End Function

也许这与我导入的文本文件有关,但这些都没有令人满意,因为我还有一些空白单元格。任何帮助将不胜感激!!

2 个答案:

答案 0 :(得分:0)

找出这些“空白”单元格中的字符。

选择一个单元格并运行下面的GetSelectionContents宏:

Sub GetSelectionContents()
MsgBox sAnalyseString(selection)
End Sub

Function sAnalyseString(sSTR As String) As String
Dim lLoop As Long, sTemp As String

For lLoop = 1 To Len(sSTR)
    sTemp = sTemp & ", " & Asc(Mid(sSTR, lLoop, 1))
Next

sAnalyseString = Mid(sTemp, 2)

End Function

然后,一旦你有了你的神秘角色,在运行你的删除宏之前替换它。

Activesheet.usedrange.Replace What:=chr(32), Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False

答案 1 :(得分:0)

不确定如果我应该回答我自己的问题,但我把上面的代码弄得乱七八糟,把它与我发现的mcaro混在一起,想出了下面的代码很慢但是它似乎为我做了伎俩。感谢所有的输入!!

 Set rangetext = Cells.SpecialCells( _
 xlCellTypeConstants, _
 xlTextValues)
 For Each rangesheet In rangetext
 If Trim(rangesheet.Value) = "" Then
 rangesheet.ClearContents
 End If
 Next
Set rangetext = Nothing
Set rangesheet = Nothing




 Range("b1:AZ60").Select
 Set rng = Intersect(Selection, Selection.Parent.UsedRange)
 For Each C In rng
   If IsEmpty(C) Then
   C.FormulaR1C1 = "=0"
   If C.Value = 0 Then
   C.ClearContents
   C.Select
   Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.Delete shift:=xlToLeft
  End If

  End If
 Next C