Excel VBA复制符合条件行至工作表时重复覆盖问题排查
Hey Albert, let's break down why your VBA code is pasting rows to the same spot repeatedly, fix that issue, and also make the whole process more efficient.
核心问题分析
Your code has two key flaws causing the duplicate paste problem:
- Unqualified cell references: When you use
Cells(i, 2)without specifying the worksheet, it defaults to whichever sheet is active when the code runs. If you're onSBwhile executing, you're checking cells inSBinstead ofSA—this breaks your logic and leads to rows getting overwritten. - Copy-paste inefficiencies: While your
SBLRowincrement logic is technically correct, usingEntireRow.Copy+PasteSpecialis slow, and if the earlier cell check fails (due to the first issue), the increment doesn't trigger, resulting in repeated pastes to the same row.
修正后的基础版本代码
First, let's fix the core issues with a straightforward, working version:
Sub test() Dim SA As Worksheet Dim SB As Worksheet Set SA = Worksheets("SA") Set SB = Worksheets("SB") Dim SALRow As Long Dim SBLRow As Long Dim i As Long ' Get last row with data in SA (using column A as reference) SALRow = SA.Cells(SA.Rows.Count, 1).End(xlUp).Row ' Determine starting row in SB (handles empty sheet case) SBLRow = SB.Cells(SB.Rows.Count, 1).End(xlUp).Row If SBLRow = 1 And SB.Cells(1, 1) = "" Then SBLRow = 1 Else SBLRow = SBLRow + 1 End If Debug.Print "SA last row: " & SALRow Debug.Print "SB start row: " & SBLRow For i = 1 To SALRow ' Always qualify cells with the SA worksheet reference! If SA.Cells(i, 2).Value = "123456789" Or SA.Cells(i, 10).Value = "123456789" Then ' Direct copy to destination (no need for PasteSpecial here) SA.Rows(i).Copy Destination:=SB.Rows(SBLRow) ' Optional: Copy only used columns instead of entire row (more efficient) ' Dim lastCol As Long ' lastCol = SA.Cells(i, SA.Columns.Count).End(xlToLeft).Column ' SA.Range(SA.Cells(i, 1), SA.Cells(i, lastCol)).Copy Destination:=SB.Cells(SBLRow, 1) SBLRow = SBLRow + 1 End If Next i ' Clear clipboard to avoid leftover data Application.CutCopyMode = False End Sub
高效优化版本(适合大数据量)
If you have thousands of journal entries, looping through each row will be slow. Use AutoFilter to grab all matching rows in one go—it's drastically faster:
Sub test_optimized() Dim SA As Worksheet Dim SB As Worksheet Set SA = Worksheets("SA") Set SB = Worksheets("SB") Dim SALRow As Long Dim SBLRow As Long Dim lastCol As Long ' Get last row and column with data in SA SALRow = SA.Cells(SA.Rows.Count, 1).End(xlUp).Row lastCol = SA.Cells(1, SA.Columns.Count).End(xlToLeft).Column ' Determine starting row in SB SBLRow = SB.Cells(SB.Rows.Count, 1).End(xlUp).Row If SBLRow = 1 And SB.Cells(1, 1) = "" Then SBLRow = 1 Else SBLRow = SBLRow + 1 End If ' Clear existing filters on SA SA.AutoFilterMode = False ' Apply filter to column B and J for "123456789" (OR condition) SA.Range(SA.Cells(1, 1), SA.Cells(SALRow, lastCol)).AutoFilter Field:=2, Criteria1:="123456789" SA.Range(SA.Cells(1, 1), SA.Cells(SALRow, lastCol)).AutoFilter Field:=10, Criteria1:="123456789", Operator:=xlOr ' Copy visible rows (skip header if needed—change "2:" to "1:" if you want to include the header) On Error Resume Next ' Handle case where no rows match the filter SA.Range(SA.Rows("2:" & SALRow), SA.Cells(SALRow, lastCol)).SpecialCells(xlCellTypeVisible).Copy Destination:=SB.Cells(SBLRow, 1) On Error GoTo 0 ' Remove filter from SA SA.AutoFilterMode = False Application.CutCopyMode = False End Sub
组合框扩展提示
When you switch to using a combobox for user-selected criteria, just replace "123456789" with your combobox value, like YourUserForm.ComboBox1.Value. Make sure you populate the combobox with your desired options first, and you're all set.
内容的提问来源于stack exchange,提问作者Albert D

