将数组分配给范围:错误1004

问题描述 投票:0回答:1

我得到了

错误1004

在这一行

wsDest.Cells(DestRow, "H").Offset(0, PasteColumn - 1).Value = CopyValues(1, PasteColumn)

完整代码

Sub CopyDataFromFiles()
    Dim SourceFolder As String
    Dim FileName As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim LastRow As Long
    Dim FoundRow As Range
    Dim CopyRange As Range
    Dim DestRow As Variant ' Use variant to handle potential errors
    Dim EconomicValue As String
    Dim NumberInFileName As String
    Dim CopyValues As Variant
    Dim PasteColumn As Long
    
    ' Turn off screen updating and alerts
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Set the source folder path
    SourceFolder = "\\dms\divs\riskoper\Shared Documents\MORisk\Shared_Folder\IRRBB\DV01\2024-03-31\Flat without EV Spread\Assets\"
    
    ' Set the destination worksheet
    Set wsDest = ThisWorkbook.Sheets(1) ' Adjust sheet index or name as needed
    
    ' Loop through each file in the folder
    FileName = Dir(SourceFolder & "*.xlsx")
    Do While FileName <> ""
        ' Extract number from file name (assuming file names are in the format "123.xlsx")
        NumberInFileName = Left(FileName, InStr(FileName, ".") - 1)
        
        ' Open the source workbook
        Set wbSource = Workbooks.Open(SourceFolder & FileName)
        If Not wbSource Is Nothing Then
            ' Set the source worksheet
            Set wsSource = wbSource.Sheets(1) ' Assuming data is in the first sheet
            
            ' Find "Economic Value" in column A
            EconomicValue = "Economic Value"
            Set FoundRow = wsSource.Columns("A:A").Find(What:=EconomicValue, LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not FoundRow Is Nothing Then
                ' Determine the last column with data in the source worksheet
                LastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
                Set CopyRange = wsSource.Range(wsSource.Cells(FoundRow.Row, "B"), wsSource.Cells(FoundRow.Row, "GO"))
                
                ' Read values from CopyRange into CopyValues array
                CopyValues = CopyRange.Value
                
                ' Find matching number in column A of destination worksheet using XLookup
                On Error Resume Next ' Continue execution if XLookup fails to find a match
                DestRow = Application.WorksheetFunction.XLookup(NumberInFileName, wsDest.Columns("A:A"), wsDest.Columns("A:A"), , 0, 2)
                On Error GoTo 0 ' Turn off error handling
                
                If Not IsError(DestRow) Then
                    ' Paste each column of CopyValues into the destination worksheet starting from column H (8th column)
                    For PasteColumn = LBound(CopyValues, 2) To UBound(CopyValues, 2)
                        wsDest.Cells(DestRow, "H").Offset(0, PasteColumn - 1).Value = CopyValues(1, PasteColumn)
                    Next PasteColumn
                    
                    Application.CutCopyMode = False ' Clear clipboard
                Else
                    MsgBox "No match found for " & NumberInFileName & " in destination worksheet."
                End If
            Else
                MsgBox "No match found for 'Economic Value' in " & FileName
            End If
            
            ' Close the source workbook without saving changes
            wbSource.Close SaveChanges:=False
        Else
            MsgBox "Failed to open workbook: " & FileName
        End If
        
        ' Get the next file
        FileName = Dir
    Loop
    
    ' Restore screen updating and alerts
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Data copied successfully."
End Sub

我正在尝试打开此文件夹中的每个文件

https://dms/divs/riskoper/Shared Documents/MORisk/Shared_Folder/IRRBB/DV01/2024-03-31/Flat without EV Spread/Assets

然后:
在 A 列中找到经济价值
复制整行
将其与我当前电子表格中的右行相匹配
将其粘贴到单元格 G 中。

匹配将如下进行:
找到您打开的文件的名称
将名称的左侧部分与我当前工作表 A 列中找到的内容的左侧部分进行匹配。

例如:
3_IAM 至塞浦路斯阿尔法银行
使用正确的公式将 3 与文件夹名称 3.xlsx 相匹配。

excel vba
1个回答
3
投票

您的问题(很可能)存在于以下陈述中:

On Error Resume Next
DestRow = Application.WorksheetFunction.XLookup(NumberInFileName, wsDest.Columns("A:A"), wsDest.Columns("A:A"), , 0, 2)
On Error GoTo 0
If Not IsError(DestRow) Then
当没有找到任何内容时,

WorksheetFunction.Xlookup
将返回默认值(第5个参数)。如果此参数为空(就像在您的代码中一样),它将引发运行时错误(1004 - 无法获取 XLookup 属性...

现在您用错误处理程序将语句括起来。该语句引发一个错误 - 由于错误处理程序而被忽略。该语句不会返回错误,

DestRow
将保持不变。

因此,如果找不到该值,则

DestRow
为空。您将其声明为 Variant,Variant 的默认值为
empty
。因此,下一个语句
If Not isError(DestRow) Then
将始终为 True,并且代码将命中语句
wsDest.Cells(DestRow, "H")...
- 这当然会失败 -
empty
不是行号的有效值。


有两种方法可以修复代码:
更改

If
语句并检查
DestRow
是否已填充:

If Not IsEmpty(DestRow) Then

使用

Application.XLookup
代替。不同之处在于,此版本不会“抛出”运行时错误,而是“返回”一个错误值(请参阅“https://stackoverflow.com/a/66223303/7599798”)。使用它,您不需要使用错误处理程序(因为不会发生错误)。现在,当未找到任何内容时,DestRow 将包含错误值: DestRow = Application.XLookup(NumberInFileName, wsDest.Columns("A:A"), wsDest.Columns("A:A"), , 0, 2) If Not IsError(DestRow) Then

© www.soinside.com 2019 - 2024. All rights reserved.