打开新宏工作簿时自定义函数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
相关产品推荐
相关产品推荐

