代码之家 › 专栏 › 技术社区 › Malganas

VBA代码未复制完整的数据集

paste copy filter vba excel

0

Malganas · 技术社区 · 2 年前

下面的代码应该复制所有匹配的REGION行,例如ASIA(EX.NEAR EAST),但由于某些原因,如果第一行(非标题)不是“ASIA(EX.NEAR EAST)”,它就不会执行任何操作。

Sub copy_data()

Dim count_col As Integer
Dim count_row As Integer
Dim og As Worksheet
Dim wb As Workbook
Dim region As String

Set og = Sheet1
region = og.Cells(1, 1).Text

Set wb = Workbooks.Add
wb.Sheets("Sheet1").Name = region

og.Activate
count_col = WorksheetFunction.CountA(Range("A4", Range("A4").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A4", Range("A4").End(xlDown)))

ActiveSheet.Range("A4").AutoFilter Field:=2, Criteria1:=region

og.Range(Cells(4, 1), Cells(count_row, count_col)). _
SpecialCells(xlCellTypeVisible).Copy
wb.Sheets(region).Cells(1, 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False
og.ShowAllData
og.AutoFilterMode = False

End Sub

如果第一行包含ASIA(EX.NEAR EAST),则在第二行等处停止。

1 回复 | 直到 2 年前

1

taller 2 年前

Cells(count_row, count_col) 不是表的右下角单元格,因为表不是从A1开始的。对于您的场景,count_row=8,count_col=4。自动滤波器适用于A4:D8范围 ,排除Region所在的所需行 ASIA (EX. NEAR EAST) .

og.Range(Cells(4, 1), Cells(count_row, count_col))

代码操作两张纸,请全部限定 Range 具有工作表对象的对象(Range(),Cells())。
Activate 没有必要,请阅读:

How to avoid using Select in Excel VBA

Microsoft文档:

Range.Resize property (Excel)

Sub copy_data()
    
    Dim count_col As Long
    Dim count_row As Long
    Dim og As Worksheet
    Dim wb As Workbook, sht As Worksheet
    Dim region As String
    Const START_CELL = "A4"
    Set og = Sheet1
    region = og.Cells(1, 1).Text
    
    Set wb = Workbooks.Add
    Set sht = ActiveSheet
    sht.Name = region
    
    With og.Range(START_CELL)
        count_col = .End(xlToRight).Column
        count_row = og.Cells(og.Rows.Count, 1).End(xlUp).Row - .Row + 1
        .AutoFilter Field:=2, Criteria1:=region
        .Resize(count_row, count_col).SpecialCells(xlCellTypeVisible).Copy
    End With
    sht.Cells(1, 1).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False
    og.ShowAllData
    og.AutoFilterMode = False
    
End Sub

如果表是 sperated 范围(即表被空白行和列包围),您可以使用 CurrentRegion .

Microsoft文档:

Range.CurrentRegion property (Excel)

    With og.Range(START_CELL)
        .AutoFilter Field:=2, Criteria1:=region
        .CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
    End With