主页 / 问题 / 1225670
Accepted
2b4fITin
Asked:2021-12-30 19:02:35 +0800 CST2021-12-30 19:02:35 +0800 CST

为什么 Pastespecial 中有错误？

  • 772

同事！帮我弄清楚：我不能以任何方式只插入值​​​​​）。

Sub GetTransactions()

    Dim my_FileNameLong As Variant
    Dim my_FileNameShort As Variant
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim ListName As String
    Dim FinalRow As Integer
    Dim i As Long
    
    Set wb = ThisWorkbook
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculateManual
    
    'Открываем файл (только для чтения) с операциями за текущий месяц + определяем переменную my_FileName
    my_FileNameLong = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")
    
    If my_FileNameLong <> False Then
        Workbooks.Open Filename:=my_FileNameLong, ReadOnly:=True
    End If
    
    'Определяем короткое имя файла с операциями, чтобы потом (после копирования данных) его закрыть по имени
    my_FileNameShort = ActiveWorkbook.Name
    
    'Определяем имя закладки, с которой будем брать информацию
    ListName = InputBox("Введите имя листа, с которого берём информацию")
    
    Worksheets(ListName).Activate
    
    'Работаем с информацией на выбранной закладке:
    'Определяем последнюю строку на выбранном листе в файле-источнике
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 4 To FinalRow
        'Sheets(ListName).Range("aw" & i & ":cj" & i).Copy wb.Sheets("CAPEX").Range("a" & Rows.Count).End(xlUp).Offset(1)
        Sheets(ListName).Range("aw" & i & ":cj" & i).Copy
        wb.Sheets("CAPEX").Range("a" & Rows.Count + 1 & ":an").PasteSpecial xlPasteValues
    Next i
    
    Application.CutCopyMode = False
    
    'Закрываем ранее открытую книгу, из которой предварительно забрали все данные
    Workbooks(my_FileNameShort).Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub
vba

1 个回答

  1. Best Answer
    wb.Sheets("CAPEX").Range("a" & Rows.Count + 1 & ":an").PasteSpecial xlPasteValues

    这一行有三个错误。

    1. 未为列指定行an

    2. Rows.Count + 1- 工作表上的行数 + 1。不是数据行，而是总行数。自然，访问不存在的行（最后一行以下）会导致错误。

    3. 经常因为无知而踩到的耙子。Rows.Count- ACTIVE 工作表上的行数。错误示例：.xlsm 格式 ( Rows.Count= 1048576) 的书的活动工作表，但我们确定 .xls 格式的书的大小（工作表上有 65536 行）。

    4. 不是错误，而是多余的：不需要指定插入的大小，指示范围的左上角单元格就足够了。

    沿着代码。

    检查是否选择了一本书：

    If my_FileNameLong <> False Then

    如果未选中，则不会打开工作簿，但代码继续使用ActiveWorkbook，即 与ThisWorkbook. 你需要强制退出。

    在InputBox您需要指定工作表的名称。如果没有这样的名称 - 一个错误。之后，您需要检查工作表是否存在，或者在代码中静态指示工作表的名称（如果不需要选择）。

    Range("aw" & i & ":cj" & i)

    范围表示法在语法上是正确的，但可读性很差。相比：

    Range("AW" & i).Resize(1, 40)
Cells(i,49).Resize(1, 40)

    Application.Calculation- 如果工作表上有很多计算可以在插入数据时开始，那么关闭重新计算是有意义的。

    循环通过线。访问工作表对象很慢。此外，在循环的每一步都有两个调用 - 复制时和粘贴时。而且，宏运行的时间越长。

    此任务不需要循环，复制/粘贴整个范围就足够了。

    如果需要循环（例如，根据条件选择每一行中的数据），那么使用数组，可以最大限度地减少对工作表的访问：1 - 将工作表中的数据放入数组中 2 - 将数据上传到床单。1 和 2 之间的所有内容都是在 RAM 中虚拟执行的。

    考虑到注释，代码可以写成以下版本：

    Sub GetTransactions_()
    Dim my_FileNameLong As String, ListName As String
    Dim FinalRow As Long

    my_FileNameLong = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*;*.xm*")
    If my_FileNameLong = "False" Then Exit Sub
    
    Call OptionsEnable_Disable(False)
    
    With Workbooks.Open(Filename:=my_FileNameLong)
        ListName = InputBox("Введите имя листа, с которого берём информацию")
        If fCorrectNameSheet(ListName) = False Then Exit Sub

        With Worksheets(ListName)
            FinalRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            .Range("AW4").Resize(FinalRow - 3, 40).Copy
        End With
        
        With ThisWorkbook.Worksheets("CAPEX")
            FinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Cells(FinalRow + 1, 1).PasteSpecial xlPasteValues
        End With
    
        .Close
    End With

    Call OptionsEnable_Disable(True)
    MsgBox "OK", 64, ""
End Sub

Sub OptionsEnable_Disable(bFlag As Boolean)
    With Application
        .CutCopyMode = False
        .ScreenUpdating = bFlag
        .DisplayAlerts = bFlag
        
        If bFlag = False Then
            .Calculation = xlCalculateManual
        Else
            .Calculation = xlCalculationAutomatic
        End If
    End With
End Sub

Function fCorrectNameSheet(ListName As String) As Boolean
    Dim sht As Worksheet
    
    For Each sht In Worksheet
        If sht.Name = ListName Then
            fCorrectNameSheet = True
            Exit Function
        End If
    Next sht
End Function
    • 0

相关问题