You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

打开新宏工作簿时自定义函数cons_market_values报错排查

跟进问题:打开其他带宏工作簿时自定义函数报错

此前问题的跟进问询,已调整代码,但每次打开另一个带宏的工作簿时,自定义函数cons_market_values都会报错。添加了Set WB = Application.ThisCell.Worksheet.Parent后问题仍存在,尝试用Do Until循环等待错误消除,但设备负担过重。

自定义函数代码

Function cons_market_values() As Double
    Application.Volatile True
    Dim wb As Workbook: Set wb = Application.ThisCell.Worksheet.Parent
    Dim total_market As Double: total_market = 0#
    Dim ws As Worksheet: For Each ws In wb.Worksheets
        If IsError(ws.Cells.Find("Kurswert in Fondswährung", LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Value) Then GoTo NextIteration
        If ws.Cells.Find("Kurswert in Fondswährung", LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Value = "N/A" Then GoTo NextIteration
        Dim foundCell As Range: Set foundCell = ws.Cells.Find(What:="Kurswert in Fondswährung", LookIn:=xlValues, LookAt:=xlWhole)
        Debug.Print foundCell.Offset(0, 1).Value
        If Not foundCell Is Nothing Then
            total_market = total_market + foundCell.Offset(0, 1).Value
        End If
NextIteration:
    Next ws
    cons_market_values = total_market
End Function

新工作簿打开事件代码(疑似导致UDF失效)

Private Sub Workbook_Open()
'------------------------------------------------
    If Application.WorksheetFunction.Max(ThisWorkbook.Sheets("log").ListObjects("tbl_log_historic").HeaderRowRange.Offset(-1, 0)) <> ThisWorkbook.Sheets("Immobilien weekly").Range("rng_week_one").value - 7 Then
        MsgBox "XXX", vbInformation + vbOKOnly, "Hinweis"
        Call eRoll.rolling_open
    End If

    ThisWorkbook.Sheets("dashboard").Activate
    ThisWorkbook.Sheets("dashboard").Range("D7").Activate
    ThisWorkbook.Sheets("dashboard").Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
''------------------------------------------------
End Sub

被调用的rolling子过程代码

Sub rolling()
'-------------------------------------
Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("Immobilien weekly")
Dim tbl As ListObject: Set tbl = WS.ListObjects("tbl_fonds_weekly")
Dim tbl_log_historic As ListObject: Set tbl_log_historic = ThisWorkbook.Sheets("log").ListObjects("tbl_log_historic")
Dim tbl_log_entries As ListObject: Set tbl_log_entries = ThisWorkbook.Sheets("log").ListObjects("tbl_log")
Dim rng_date As Range: Set rng_date = WS.Range("rng_week_one")
Dim j As Integer, rng_found As Range, rng_date_found As Range
'-------------------------------------
tbl_log_historic.ListColumns.Add
tbl_log_historic.HeaderRowRange.Cells(1, tbl_log_historic.Range.Columns.Count).value = rng_date.value - 7
tbl_log_historic.HeaderRowRange.Cells(1, tbl_log_historic.Range.Columns.Count).Offset(-1, 0).value = rng_date.value - 7
Dim n As Integer: For n = 1 To tbl.DataBodyRange.Rows.Count

TryAgain:
On Error Resume Next
    Set rng_found = tbl_log_historic.ListColumns("ISIN").DataBodyRange.Find(tbl.DataBodyRange.Cells(n, tbl.ListColumns("ISIN").Index), LookIn:=xlValues, LookAt:=xlWhole)
    j = tbl_log_historic.ListColumns(CStr(rng_date.value - 7)).Range.Column

If (Not rng_found Is Nothing) Then
    tbl.DataBodyRange.Cells(n, tbl.ListColumns("1").Index).Copy: ThisWorkbook.Sheets("log").Cells(rng_found.Row, j).PasteSpecial Paste:=xlPasteValues
    Else:
        tbl_log_historic.ListRows.Add
        ThisWorkbook.Sheets("log").Cells(tbl_log_historic.Range.Rows(tbl_log_historic.Range.Rows.Count).Row, tbl_log_historic.ListColumns("ISIN").Range.Column).value = tbl.DataBodyRange.Cells(n, tbl.ListColumns("ISIN").Index).value
        GoTo TryAgain
End If
Next n
'-------------------------------------
For n = tbl.ListColumns("2").Index To tbl.Range.Columns.Count
    tbl.ListColumns(n).DataBodyRange.Copy: tbl.ListColumns(n - 1).DataBodyRange.PasteSpecial Paste:=xlPasteValues
    tbl.ListColumns(n).DataBodyRange.ClearContents
Next n
'-------------------------------------
Dim target_row As Integer: target_row = tbl_log_entries.DataBodyRange.Rows.Count + tbl_log_entries.HeaderRowRange.Row + 1
ThisWorkbook.Sheets("log").Cells(target_row, tbl_log_entries.ListColumns("Nutzer").Range.Column).value = Environ("Username")
ThisWorkbook.Sheets("log").Cells(target_row, tbl_log_entries.ListColumns("Datum Eintrag").Range.Column).value = Date
ThisWorkbook.Sheets("log").Cells(target_row, tbl_log_entries.ListColumns("Fonds").Range.Column).value = "Weekly Roll"
ThisWorkbook.Sheets("log").Cells(target_row, tbl_log_entries.ListColumns("Datum").Range.Column).value = rng_date.value
'-------------------------------------
End Sub

内容的提问来源于stack exchange,提问作者ezvk

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.24 22:54:19