1

失敗したコードが含まれているため、これは長いクエリです。

問題: テキスト ファイルを Excel にインポートした後、ワークシートに多数の「空白」セルが含まれています。私は他の場所で次のコードを正常に使用しましたが、今回はうまくいきませんでした。

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

私は Web を検索し、いくつかの提案された解決策を見つけました (以下)。上記のコードの前に、以下の 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

おそらく、インポート元のテキスト ファイルに関係があるのでしょうが、まだ空白のセルがいくつかあるため、これらのどれも満足に機能していません。どんな助けでも大歓迎です!!

4

2 に答える 2

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
于 2012-10-31T11:55:26.017 に答える
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

于 2012-10-30T18:26:47.293 に答える