VBA技术问询：筛选CI列后如何高效选择A:CD对应行数据

Hey there! I totally get the frustration of slow VBA code with 50k+ rows—let’s ditch those clunky offset loops and use Excel’s built-in tools to get this done fast. Here’s a solid solution that fixes performance issues and addresses that problematic line before your End With:

Core Principles to Fix Your Problem #

• Skip loops entirely: Excel’s AutoFilter and SpecialCells are optimized for large datasets, way faster than iterating row by row.
• Target the right range directly: We’ll filter column CI for "No" and "N/A", then copy the visible rows from columns A to CD without messy offsets.
• Handle edge cases: Make sure we don’t copy just the header if there are no matching rows, and clean up filters afterward.

Working VBA Code #

Sub FilterAndCopyRows()
    Dim ws As Worksheet
    Dim fullDataRange As Range
    Dim filteredVisibleRange As Range
    
    ' Set your target worksheet (replace "DataSheet" with your actual sheet name)
    Set ws = ThisWorkbook.Worksheets("DataSheet")
    
    ' Boost performance by disabling screen updates and automatic calculations
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error GoTo Cleanup ' Ensure we reset settings even if an error occurs
    
    ' Clear any existing filters to avoid interference
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    ' Define the full data range (includes headers, adjust row 1 if your header is on a different row)
    Set fullDataRange = ws.Range("A1:CD" & ws.Cells(ws.Rows.Count, "CI").End(xlUp).Row)
    
    ' Apply filter to column CI (CI is the 87th column; adjust if your data starts at a different column)
    fullDataRange.AutoFilter Field:=87, Criteria1:="No", Operator:=xlOr, Criteria2:="N/A"
    
    ' Get visible rows (exclude header row with Offset(1,0); adjust if header isn't row 1)
    On Error Resume Next ' Ignore error if no matching rows exist
    Set filteredVisibleRange = fullDataRange.Offset(1, 0).SpecialCells(xlCellTypeVisible)
    On Error GoTo Cleanup
    
    ' Only copy if there are matching rows
    If Not filteredVisibleRange Is Nothing Then
        ' Paste to your destination (replace "Sheet2!A1" with your target location)
        filteredVisibleRange.Copy Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1")
    Else
        MsgBox "No rows found with ""No"" or ""N/A"" in column CI."
    End If

Cleanup:
    ' Reset filters, screen updates, and calculations
    ws.AutoFilterMode = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    If Err.Number <> 0 Then MsgBox "Error occurred: " & Err.Description
End Sub

Key Fixes & Explanations #

1. Performance boost: By using Excel’s native filtering instead of loops, we cut down processing time drastically—critical for 50k+ rows.
2. Fixing the problematic line: Your original code likely had an incorrect range reference before End With (like misusing Offset). This code directly targets visible rows without messy row-by-row checks.
3. Column number check: CI is the 87th column (A=1, B=2... CI=87). Double-check this if your data doesn’t start at column A.
4. Cleanup safety: The error handler ensures filters and application settings are always reset, even if the macro fails mid-run.

Quick Tips #

• If your header isn’t on row 1, adjust Offset(1,0) to match your header row count (e.g., Offset(2,0) for a header on row 2).
• For even faster performance, you can add Application.EnableEvents = False at the start and reset it in the cleanup routine.

内容的提问来源于stack exchange，提问作者papacoolaid666