EXCEL VBA處理數量數據，如何更快地過濾數據並將粘貼復制到另一張紙上？

Question

我有一個CVS文件，其數據量超過十萬。 因為數據文件有許多不規則的空間，所以我使用了過濾器“空間”來一一過濾。 過濾后，我將此列復制並粘貼到另一張紙上。 我執行這些步驟，直到列數據結束。 我的文件有許多列和數十萬行，但經過過濾后的“空格”大約為10萬。 但是現在我遇到了問題，我等待了大約5分鍾太長時間才能完成此工作。 我怎樣才能跑得更快？ 我嘗試使用Selection.SpecialCells(xlCellTypeVisible).Copy ，花費了更多時間。 謝謝！

以下是我的excel VBA過濾器空間並復制粘貼代碼

Sub FilterData()

    On Error GoTo ErrorHandler

    Dim AddSheetName As String
    Dim CSVNoExtensionName As String

    Dim LastColumn As Long
    Dim FinalRow As Variant

    Dim idxDataCol, idxPasteCol As Integer

    Dim sDelayTime As String

    sDelayTime = "02"

    AddSheetName = "sheet1"

    Dim Time0#
    Time0 = Timer      

    Workbooks(CSVDataFileName).Activate  

    If InStr(CSVDataFileName, ".") > 0 Then
        CSVNoExtensionName = Left(CSVDataFileName, InStr(CSVDataFileName, ".") - 1)
    End If

    Sheets.Add(After:=ActiveSheet).Name = AddSheetName

    Worksheets(CSVNoExtensionName).Activate

    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column   
    FinalRow = Range("A1").End(xlDown).Row    

    idxPasteCol = 1  

    For idxDataCol = 2 To LastColumn Step 1

        Cells(1, idxDataCol).Select

        Selection.AutoFilter
        ActiveSheet.Range(Cells(1, 1), Cells(FinalRow, LastColumn)).AutoFilter Field:=idxDataCol, Criteria1:="<>"

        Dim rng1, rng2 As Range
        Set rnge2 = Range(Cells(1, idxDataCol), Cells(FinalRow, idxDataCol))
        Set rng1 = Union(Range("A1:A" & FinalRow), rnge2)
        rng1.Select
        Selection.Copy        

        Application.Wait (Now + TimeValue("0:00:" & sDelayTime))

        Sheets(AddSheetName).Select
        ActiveSheet.Cells(1, idxPasteCol).Select
        ActiveSheet.Paste

        Columns(idxPasteCol).Font.ColorIndex = 41

        Sheets(CSVNoExtensionName).Select
        Application.CutCopyMode = False
        Selection.AutoFilter

        idxPasteCol = idxPasteCol + 2

    Next idxDataCol

    ActiveSheet.Cells(1, 1).Select

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:=CSVNoExtensionName & ".xlsx", FileFormat:=xlOpenXMLStrictWorkbook, CreateBackup:=False

    Exit Sub   

End Sub

Answer 1

無法清楚地了解如何過濾“空間”。 假設（從代碼中）該目標是過濾出包含空格或空格的任何行，我想直接從文本文件讀取和寫入文本。

此外，如果假設正確，則代碼中的選擇，激活等命令會增加操作時間。 也可以對每列進行循環操作，但是認為並集范圍方法是不必要的。 將過濾器應用於所有列后，可以復制和粘貼整個數據區域。 但這也可能擴大1004錯誤的可能性，因為“ Excel女士無法創建或使用數據范圍引用，因為它太復雜了”，因為此處要處理的數據超過100K。

因此，我嘗試使用超過15萬行X 50列的數據，將數據處理為文本文件需要20幾秒鍾，打開結果CSV文件並將其另存為xlsx 20秒鍾。 代碼中使用的文件格式存在一些問題（至少在Excel 2007中），因此我直接將其保存為xlsx 。

Sub test()
Dim oFlNo As Integer, iFlNo As Integer
Dim oFlName As String, iFlName As String
Dim oFolder As String, iFolder As String
Dim Arr As Variant, HaveBlank  As Boolean
Dim Tm As Double

Tm = Timer
iFlName = "C:\users\user\desktop\FilerCSv.Csv"
oFlName = "C:\users\user\desktop\FilteredCSv.Csv"

iFlNo = FreeFile
Open iFlName For Input As #iFlNo
oFlNo = FreeFile
Open oFlName For Output As #oFlNo


        Do While Not EOF(iFlNo)    ' Loop until end of file.
        Line Input #iFlNo, Ln    ' Read line into variable.
        Arr = Split(Ln, ",")
        HaveBlank = False
            For Each xVal In Arr
            xVal = Trim(xVal)
                If xVal = "" Then
                HaveBlank = True
                Exit For
                End If
            Next
            If HaveBlank = False Then
            Write #oFlNo, Ln
            End If
        Loop
    Close #iFlNo
    Close #oFlNo
Debug.Print Timer - Tm

Workbooks.Open (oFlName)
oFlName = Left(oFlName, Len(oFlName) - 4)
ActiveWorkbook.SaveAs Filename:=oFlName & ".xlsx"   ', FileFormat:=xlOpenXMLStrictWorkbook, CreateBackup:=False
Debug.Print Timer - Tm

End Sub

由於我個人不希望保留計算，事件處理和屏幕更新（通常情況下），因此我沒有添加標准行。 但是，您可以自行決定使用這些標准技術。