私は大量のデータをExcelで定期的に処理し、「スクラブ」するのは、印刷できない文字だけを含むセルを見つけてクリアすることです。VBAを使用して印刷できない文字だけを含むすべてのセルをすばやくクリアするにはどうすればよいですか?
明確にするために、クリアするマッチングセルの定義は、黒いフォントでフォーマットしたときに用紙にインクを印刷しないセルです。
これだけで細胞を含まれています
- vbNullString、この式と同じ値:=「」
- 空間の任意のタイプを(私は多くの異なる空白文字があることを、ハードな方法を見つけました。 )
- タブ
- 改行のいずれのタイプ
- その他の非印字文字
良い答えを検討します:
- ワークシートは、数百のセルのExcelデータと、何百万の行数千のを含んでいてもよいです。
- クリアするマッチングセルには、複数の非印字文字が含まれることがあります。
- ワークシートには、大きな範囲の空の範囲が含まれる場合があります。
- 速度は大きな要因です。
- 印刷可能な文字を含むセル内にある場合は、印刷できない文字を保持することが重要です。 私が試してみました何
:ここ は、配列にワークシートのセルの値を保存する、これまでの私のコードだし、それらを介して160または以下に等しいのUnicode文字番号を探して一つずつループ私が知る限り、印字不可能な文字のほとんどまたはすべてをカバーする32。それは、単一の印刷不能な文字に等しいセルを見つけるだけである(すなわち、2つのスペースのみを含むセルが欠落する)。私のマシン上では、1秒間に約250,000個の細胞が走ります。
Public Sub EmptyAllBlankCells()
' Get the last row in the worksheet
Dim maxRow As Long
maxRow = GetMaxCell.Row
' Get the last column in the worksheet
Dim MaxCol As Byte
MaxCol = GetMaxCell.Column
' Create an array of all worksheet cell values.
Dim arrData As Variant
ReDim arrData(0 To maxRow, 0 To MaxCol)
arrData = ActiveSheet.Range(Cells(1, 1), Cells(maxRow, MaxCol))
' Empty the contents of blank and whitespace only cells.
Dim iRow As Long
Dim iCol As Long
Dim iCellText As Variant ' or BYTE
For iRow = 1 To UBound(arrData, 1) ' First array dimension is rows.
For iCol = 1 To UBound(arrData, 2) ' Second array dimension is columns.
On Error Resume Next
iCellText = AscW(arrData(iRow, iCol))
On Error GoTo 0
If iCellText <= 32 Or iCellText = 160 Then
' Cell contains only a single non-printable character.
arrData(iRow, iCol) = Empty ' Empty the cell.
End If
iCellText = Empty
Next iCol
Next iRow
' Write array back to worksheet.
Dim Destination As Range
Set Destination = Range("A1")
Destination.Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData
End Sub
Private Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range
'Returns the last cell containing a value, or A1 if Worksheet is empty
Const NONEMPTY As String = "*"
If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange
If WorksheetFunction.CountA(rng) = 0 Then
Set GetMaxCell = rng.Parent.Cells(1, 1)
Else
Dim lRow As Range
With rng
Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
After:=.Cells(1, 1), _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows)
If Not lRow Is Nothing Then
Dim lCol As Range
Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
After:=.Cells(1, 1), _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns)
Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
End If
End With
End If
End Function