Макрос не удаляет все пустые ячейки

Это длинный запрос, потому что я включаю неудачный код.

Проблема: когда я закончил импортировать текстовый файл в Excel, мой рабочий лист содержит несколько «пустых» ячеек. Я успешно использовал следующий код в другом месте, но в этом случае он не работает для меня.

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

Я искал в Интернете и нашел ряд предлагаемых решений (ниже). Я пытался запустить каждый из 4 фрагментов кода ниже перед моим кодом выше, чтобы очистить содержимое предположительно пустых ячеек, но пока ничего не сработало.

Номер 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

Номер 2------------------------------------------------ --

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

Номер 3------------------------------------------------ -

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

Номер 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

Возможно, это как-то связано с текстовым файлом, из которого я импортировал, но ни один из них не работал удовлетворительно, так как у меня все еще есть несколько пустых ячеек. Любая помощь приветствуется!!


excel vba excel-2010
person Brackers    schedule 30.10.2012    source источник
comment
Вы можете опубликовать образец вашего текстового файла?   -  person Scott Holtzman    schedule 30.10.2012
comment
или образец файла Excel, включая пустые ячейки   -  person nutsch    schedule 30.10.2012
comment
или вы пытались зайти в любые оставшиеся пустые ячейки, чтобы увидеть, какой символ там находится, из-за чего они кажутся пустыми, но не являются?   -  person Scott Holtzman    schedule 30.10.2012
comment
Бьюсь об заклад, есть возврат каретки, который все портит. Попробуйте заменить пустые ячейки, удалив возврат каретки   -  person Sorceri    schedule 30.10.2012
comment
проверьте ячейки, чтобы убедиться, что они действительно заполнены ?len(range("A1")) в ближайшем окне. Результат, отличный от нуля, означает, что ячейки на самом деле не пусты. Если вы хотите проверить фактический текст, этот код for i=1 to len(range("A1")):?asc(mid(range("A1"),i,1));";";:next покажет вам значения ascii символов   -  person SeanC    schedule 30.10.2012
comment
@ Sorceri, спасибо, но я боюсь, что это был не возврат каретки, см. мой ответ Nutsch ниже.   -  person Brackers    schedule 31.10.2012

Ответы (2)


arrow_upward
0
arrow_downward

не уверен, должен ли я как-то ответить на мой собственный вопрос, подобный этому, но я возился с фрагментами кода, которые у меня были выше, и смешал их с 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
person Brackers    schedule 31.10.2012

arrow_upward
0
arrow_downward

Узнайте, какие символы у вас есть в этих «пустых» ячейках.

Выберите ячейку и запустите макрос 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

person nutsch    schedule 30.10.2012
comment
На сайте Чипа Пирсона есть полезная надстройка под названием CellView, которая будет помечать символы - person brettdj; 31.10.2012
comment
Привет @nutsch. Я попробовал ваш код. Msgbox ничего не сообщил для некоторых ячеек и серию 32 для других. 32 Я обнаружил, что это символ ASCII для пробела. Я думал, что функция обрезки может работать с пробелами? - person Brackers; 31.10.2012