清除、修剪VBA错误(删除已过滤的数据，留下#NA，不适用于大数据)

Question

我已经成功地使用了下面的VBA来清理和修剪导出的数据。

我开始看到3个问题。

1. 我已经开始在格式化为表的数据上使用它经过筛选，脚本将删除行。我应该在首先删除列表中任何筛选器的脚本，还是其他筛选器方式
2. 另一个问题是，如果数据量巨大，它就会结束。你看到了吗我在脚本中遗漏了什么错误
3. 我注意到的第三个问题是，数据中弹出了许多#Value或#NA。这能避免吗

Sub CallCleanTrimExcel()
Dim MasterFile As Workbook
Dim SurveyRptName As String
Dim SurveyReport As Workbook
Set MasterFile = ThisWorkbook '
SurveyRptName = Application.GetOpenFilename("Excel files (*.xlsx), *xlsx", 1, _
"Please select the data you want to cleanse.", , False)
If SurveyRptName <> "False" Then
Set SurveyReport = Workbooks.Open(SurveyRptName)
End If
SurveyReport.Activate
Dim rng As Range
Dim Area As Range
Dim rngTemp As Range
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not rngTemp Is Nothing Then
Range(Cells(1, 1), rngTemp).Select
End If
Dim arr() As Variant
Dim m As Double
Dim n As Double
arr = Selection.Value
For m = LBound(arr, 1) To UBound(arr, 1)
For n = LBound(arr, 2) To UBound(arr, 2)
arr(m, n) = CleanTrimExcel(arr(m, n))
Next n
Next m
Selection = arr()
ActiveSheet.Cells.NumberFormat = "General"
MsgBox "Cleaning done!"
End Sub

Function CleanTrimExcel(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
Dim X As Long
Dim CodesToReplace() As Variant
If ConvertNonBreakingSpace Then
ReDim CodesToReplace(1 To 7)
CodesToReplace = Array(127, 129, 141, 143, 144, 157, 160)
Else
ReDim CodesToReplace(1 To 6)
CodesToReplace = Array(127, 129, 141, 143, 144, 157)
End If
For X = LBound(CodesToReplace) To UBound(CodesToReplace)
If InStr(S, Chr(CodesToReplace(X))) Then S = Replace(S, Chr(CodesToReplace(X)), Chr(0))
Next
CleanTrimExcel = WorksheetFunction.Trim(WorksheetFunction.Clean(S))
End Function

Answer 1

感谢您的建议。我想我能够纠正错误。第三个错误我无法复制，所以数据可能从一开始就损坏了。

现在这个脚本不应该替换任何数据。：-(

Sub CallCleanTrimExcel()
Dim MasterFile As Workbook
Dim SurveyRptName As String
Dim SurveyReport As Workbook
Set MasterFile = ThisWorkbook '
SurveyRptName = Application.GetOpenFilename("Excel files (*.xlsx), *xlsx", 1, _
"Please select the data you want to cleanse.", , False)
If SurveyRptName <> "False" Then
Set SurveyReport = Workbooks.Open(SurveyRptName)
End If
If SurveyRptName = "False" Then
MsgBox ("No file selected.")
Exit Sub
End If
SurveyReport.Activate
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
Dim rng As Range
Dim Area As Range
Dim rngTemp As Range
Range("a1", Cells(Range("a1000000").End(xlUp).Row, Range("xfd1").End(xlToLeft).Column)).Select
Set rngTemp = Selection
If Not rngTemp Is Nothing Then
MsgBox "Data found! Cleaning will now start. It can take a while. Don't worry if Excel gets blank."
End If
Dim arr() As Variant
Dim m As Double
Dim n As Double
arr = Selection.Value
For m = LBound(arr, 1) To UBound(arr, 1)
For n = LBound(arr, 2) To UBound(arr, 2)
arr(m, n) = CleanTrimExcel(arr(m, n))
Next n
Next m
Selection = arr()
ActiveSheet.Cells.NumberFormat = "General"
ActiveSheet.ListObjects.Add(xlSrcRange, Selection.CurrentRegion, , xlYes).Name = "Data_table"
MsgBox "Cleaning done!"
End Sub

Function CleanTrimExcel(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
Dim X As Long
Dim CodesToReplace() As Variant
If ConvertNonBreakingSpace Then
ReDim CodesToReplace(1 To 7)
CodesToReplace = Array(127, 129, 141, 143, 144, 157, 160)
Else
ReDim CodesToReplace(1 To 6)
CodesToReplace = Array(127, 129, 141, 143, 144, 157)
End If
For X = LBound(CodesToReplace) To UBound(CodesToReplace)
If InStr(S, Chr(CodesToReplace(X))) Then S = Replace(S, Chr(CodesToReplace(X)), Chr(0))
Next
CleanTrimExcel = WorksheetFunction.Trim(WorksheetFunction.Clean(S))
End Function