Экспорт и последующий анализ данных spc

Sub v3_DataTransfer()
Dim mstr As String, mFlag As Boolean, i&, j&, mRng As Range
Dim mARR(), strC1$, strC2$
   Application.ScreenUpdating = False
   With Application.FileDialog(msoFileDialogFilePicker)
      .InitialFileName = Application.DefaultFilePath & "\":  .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Canceled":   Exit Sub
                Else: mstr = .SelectedItems(1)
        End If
        mstr = "TEXT;" & mstr
   End With: [a1].Select
    With ActiveSheet.QueryTables.Add(Connection:=mstr, _
                                                         Destination:=ActiveCell)
        .TextFilePlatform = 1251  ' fatefully
        .TextFileParseType = xlFixedWidth  ' fatefully
        .Refresh BackgroundQuery:=False ' fatefully
    End With
    With ActiveSheet.Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)
        .Replace What:=",", Replacement:=";", LookAt:=xlPart, SearchOrder:=xlByRows
        .Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=True, Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True
    End With
'Stop
   Call mRemoveDublicate_DeleteEmpty
'--ADD--SORT---DATA---------------------------------------------
      With Sheets("Reunion")
         strC1 = IIf(.[a1].Value = vbNullString, "A1", _
                     .Rows(.UsedRange.Rows.Count + 1).Cells(1).Address)
      End With
      With ActiveSheet
         strC2 = IIf(strC1 = "A1", strC1, "A3")
         mARR = .Range(.Range(strC2), .Cells(.UsedRange.Rows.Count, _
                     .UsedRange.Columns.Count)).Value: .Cells.Delete
      End With
      With Sheets("Reunion")
         If (.UsedRange.Rows.Count + UBound(mARR, 1)) > .Rows.Count Then
            MsgBox "YOU   NEEEEEED   NEW   SHEETS !":   End
         End If
         .Range(strC1).Resize(UBound(mARR, 1), UBound(mARR, 2)).Value = mARR
         .[a3].Resize(UBound(mARR, 1), UBound(mARR, 2)).Columns.AutoFit
            With Range(.[a3], .Cells(.UsedRange.Rows.Count, _
                                                .UsedRange.Columns.Count))
               .Sort .Cells(1), xlAscending, , Header:=xlNo
            End With
      End With
'==End==ADD==SORT==DATA============================
'Stop
''--INSERT--DATA--WITHOUT--SORTING-------------------
'      With Sheets("Reunion")
'         strC1 = IIf(.[a1].Value = vbNullString, "A1", "A3")
'      End With
'      With ActiveSheet
'         strC2 = IIf(strC1 = "A1", strC1, "A3")
'         mARR = .Range(.Range(strC2), .Cells(.UsedRange.Rows.Count, _
'                     .UsedRange.Columns.Count)).Value: .Cells.Delete
'      End With
'      With Sheets("Reunion")
'         If (.UsedRange.Rows.Count + UBound(mARR, 1)) > .Rows.Count Then
'            MsgBox "YOU   NEEEEEED   NEW   SHEETS !":   End
'         End If
'         If strC1 = "A1" Then
'            .Range(strC1).Resize(UBound(mARR, 1), UBound(mARR, 2)).Value = mARR
'               Else
'                  .Rows(Range(strC1).Row & ":" & UBound(mARR, 1) + 2).Insert Shift:=xlDown
'                  .Range(strC1).Resize(UBound(mARR, 1), UBound(mARR, 2)).Value = mARR
'         End If
'         .Range(.[a3], .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Columns.AutoFit
'      End With
''==END==INSERT==DATA=================================
   Application.ScreenUpdating = True
   Erase mARR: MsgBox Space(10) & "D O N E!"
End Sub
 
Sub mRemoveDublicate_DeleteEmpty()
 Dim i&, j&, mARR(), rr As Range
   Application.ScreenUpdating = False
   With ActiveSheet
      ReDim mARR(0 To .UsedRange.Columns.Count - 1)
      For i = 1 To .UsedRange.Columns.Count:  mARR(i - 1) = i:  Next i
      Set rr = .Range(.[a3], .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
      rr.RemoveDuplicates (mARR), xlNo
'   ------------------------
      'from toiai
   Dim x As Range, lastCol&
    On Error Resume Next
        lastCol = .UsedRange.Columns.Count + 1
        For Each x In rr.SpecialCells(xlCellTypeBlanks)
            .Cells(x.Row, lastCol) = 1
        Next
        Set x = Cells(1, lastCol)
        .UsedRange.Columns(lastCol).ColumnDifferences(x).EntireRow.Delete
    End With
' ================================
''----------------------------------------
''my own
'   With rr
'       For i = .Rows.Count To 1 Step -1
'         If Application.CountA(.Rows(i)) < .Columns.Count Then .Rows(i).Delete
'      Next 'i
'   End With:    Set mRng = Nothing
'' =======================================
   Erase mARR: Set rr = Nothing: Application.ScreenUpdating = True
End Sub

Sub CvsToXlsx()
    Dim mRng As Range, x As Range, i&, j&, mARR(), LastCol&
    Dim WbCSV As Workbook, WbSvod As Workbook
    
    Set WbSvod = ActiveWorkbook
    FileCSV = Application.GetOpenFilename(filefilter:="Workbooks(*.csv),*.csv", _
                Title:="Выберите файлы CSV", MultiSelect:=True)
    
    If Not IsArray(FileCSV) Then Exit Sub
    Application.ScreenUpdating = False
    'разброска данных файлов по листам
    For j = 1 To UBound(FileCSV)
        Workbooks.Open (FileCSV(j))
        Set WbCSV = ActiveWorkbook
        WbCSV.Sheets(1).Copy After:=WbSvod.Sheets(WbSvod.Sheets.Count)
        ActiveSheet.Name = "DataLogSPC_" & j
        ActiveSheet.Columns.AutoFit
        WbCSV.Close False
    Next
        
    With WbSvod
        'обработка листов
        For j = 2 To .Sheets.Count
            With .Sheets(j)
                ' комбинированный код с Igor_T
                ReDim mARR(0 To .UsedRange.Columns.Count - 1)
                For i = 1 To .UsedRange.Columns.Count:  mARR(i - 1) = i: Next i
                Set mRng = .Range(.[a3], .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
                mRng.RemoveDuplicates (mARR), xlNo
                'On Error Resume Next
                LastCol = .UsedRange.Columns.Count + 1
                For Each x In mRng.SpecialCells(xlCellTypeBlanks)
                    .Cells(x.Row, LastCol) = 1
                Next
                Set x = .Cells(1, LastCol)
                .UsedRange.Columns(LastCol).ColumnDifferences(x).EntireRow.Delete
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub