Очистка ошибок Trim-VBA (удаляет отфильтрованные данные, оставляет #NA, не работает с большими данными) - PullRequest
Новая
       6

Очистка ошибок Trim-VBA (удаляет отфильтрованные данные, оставляет #NA, не работает с большими данными)

0 голосов
/ 11 марта 2020

Я использовал этот 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

1 Ответ

0 голосов
/ 12 марта 2020

Спасибо за ваш совет. Я думаю, что смог исправить ошибки. Третья ошибка, которую я не смог воспроизвести, поэтому, возможно, данные были повреждены с самого начала.

Теперь этот скрипт не должен заменять никакие данные. : -) 

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
...