#excel #vba
Вопрос:
Я создал макрос, который работает именно так, как я хочу. Тем не менее, я получаю сообщение об ошибке каждый раз, когда оно запускается, которое указано в названии этого вопроса. Вот мой код:
Sub Calculate() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Dim Source As Worksheet Dim SourceRow As Long Dim SourceRange As String Dim Target As Worksheet Dim TargetRow As Long Dim TargetRange As String Dim ColumnCount As Long Dim lastRow As Long Dim filterRange As Range Dim copyRange As Range Dim visibleTotal As Long Set Source = ActiveWorkbook.Worksheets("Sheet1") Set Target = ActiveWorkbook.Worksheets("CALCULATION") t = Now() If Source.Cells("1,") = Empty Then MsgBox "Please check if there is data in Sheet1" If Source.Cells("1,") = Empty Then Exit Sub TargetRow = 2 ColumnCount = Source.Range("A:K").Columns.Count For SourceRow = 1 To Source.UsedRange.Rows.Count SourceRange = Range(Cells(SourceRow, 1), Cells(SourceRow, ColumnCount)).Address While Target.Cells(TargetRow, 6).Value lt;gt; "" TargetRow = TargetRow 1 Wend TargetRange = Range(Cells(TargetRow, 1), Cells(TargetRow, ColumnCount)).Address Target.Range(TargetRange).Value = Source.Range(SourceRange).Value TargetRow = TargetRow 1 Next Target.AutoFilterMode = False lastRow = Target.Range("A" amp; Target.Rows.Count).End(xlUp).Row Set filterRange = Target.Range("A1:K" amp; lastRow) filterRange.AutoFilter field:=10, Criteria1:="Domestic Shares" Target.Range("M2").Value = Application.WorksheetFunction.Subtotal(2, Range("$E2:D" amp; Rows(Rows.Count).End(xlUp).Row)) Target.ShowAllData filterRange.AutoFilter field:=10, Criteria1:="Foreign Shares" Target.Range("M3").Value = Application.WorksheetFunction.Subtotal(2, Range("$E2:D" amp; Rows(Rows.Count).End(xlUp).Row)) Target.ShowAllData filterRange.AutoFilter field:=10, Criteria1:="Bonds EUR In" Target.Range("M4").Value = Application.WorksheetFunction.Subtotal(2, Range("$E2:D" amp; Rows(Rows.Count).End(xlUp).Row)) Target.ShowAllData filterRange.AutoFilter field:=10, Criteria1:="Bonds EUR Out" Target.Range("M5").Value = Application.WorksheetFunction.Subtotal(2, Range("$E2:D" amp; Rows(Rows.Count).End(xlUp).Row)) Target.ShowAllData filterRange.AutoFilter field:=10, Criteria1:="Own Products AB" Target.Range("M6").Value = Application.WorksheetFunction.Subtotal(2, Range("$E2:D" amp; Rows(Rows.Count).End(xlUp).Row)) MsgBox "Elapsed Time in Hrs:Min:Sec :" amp; Format(Now() - t, "hh:mm:ss") Target.ShowAllData Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Target.AutoFilterMode = False Application.EnableEvents = True End Sub Sub Clear() Worksheets("CALCULATION").Range(Cells(2, 11), Cells(Rows.Count, 1)).ClearContents Worksheets("CALCULATION").Range("M2:M6").ClearContents End Sub Sub Clear2() Worksheets("Sheet1").Cells.Clear End Sub Я добавил несколько строк кода в начале и в конце (Application.calculate, application.screenupdating и т.д.), Чтобы макрос работал более эффективно. На некоторых компьютерах моих коллег excel вообще перестает работать во время выполнения этого макроса. Также для контекста: Объем данных, которые вставляются на лист с именем «Лист1», составляет около 6000-8000 строк и 34 столбцов данных.
Комментарии:
1. В какой момент в вашем коде у Excel заканчиваются ресурсы.
2. Ошибка появляется, когда я запускаю любую из трех подмен. После того, как я запускаю подсчет, данные действительно вставляются из листа 1, после чего отображается ошибка. Таким образом, сообщение об ошибке появляется, когда я запускаю макрос и когда я также просто копирую данные из другого файла Excel на Лист1.
3. Трудно сказать что-нибудь полезное, не зная, что и как вычисляется.
4. Это довольно просто. Он просто вставляет данные с одного листа на другой. Применяет некоторые текстовые фильтры один за другим, а затем подсчитывает количество строк для каждого отдельного текстового фильтра.
5. У вас есть довольно много неквалифицированных вызовов диапазона/ячеек, например,
Application.WorksheetFunction.Subtotal(2, Range("$E2:D" amp; Rows(Rows.Count).End(xlUp).Row))я бы начал с того, чтобы убедиться, что у всех них есть квалификатор рабочего листа.
Ответ №1:
Посмотрим, не изменит ли это что-нибудь:
Sub Calculate() Const NUM_COLS As Long = 11 Dim Source As Worksheet Dim SourceRow As Long Dim SourceRange As Range 'not string Dim Target As Worksheet, wb As Workbook, rw As Range, v, cResult As Range Dim TargetRow As Long Dim TargetRange As String Dim ColumnCount As Long Dim lastRow As Long Dim filterRange As Range, rngCalc As Range Dim copyRange As Range Dim visibleTotal As Long, t Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set wb = ActiveWorkbook Set Source = wb.Worksheets("Sheet1") Set Target = wb.Worksheets("CALCULATION") t = Now() If Len(Source.Cells(1).Value) = 0 Then MsgBox "Please check if there is data in Sheet1" Exit Sub End If TargetRow = 2 'copy source rows to first available slots on Target For SourceRow = 1 To Source.UsedRange.Rows.Count While Len(Target.Cells(TargetRow, 6).Value) gt; 0 TargetRow = TargetRow 1 Wend Target.Cells(TargetRow, 1).Resize(1, NUM_COLS).Value = _ Source.Cells(SourceRow, 1).Resize(1, NUM_COLS).Value Next Target.AutoFilterMode = False With Target Set filterRange = .Range("A1:K" amp; .Cells(.Rows.Count, "A").End(xlUp).Row) End With Set cResult = Target.Range("M2").Value 'you can reduce the repetition using an array here For Each v In Array("Domestic Shares", "Foreign Shares", "Bonds EUR In", _ "Bonds EUR Out", "Own Products AB") filterRange.AutoFilter field:=10, Criteria1:=v Set rngCalc = Target.Range("D2:E" amp; Target.Cells(Rows.Count, "E").End(xlUp).Row) cResult.Value = Application.Subtotal(2, rngCalc) Set cResult = cResult.Offset(1, 0) 'next result cell Next v MsgBox "Elapsed Time in Hrs:Min:Sec :" amp; Format(Now() - t, "hh:mm:ss") Target.ShowAllData Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Target.AutoFilterMode = False Application.EnableEvents = True End Sub Sub Clear() With Worksheets("CALCULATION") .Range(.Cells(2, 11), .Cells(.Rows.Count, 1)).ClearContents .Range("M2:M6").ClearContents End With End Sub Sub Clear2() Worksheets("Sheet1").Cells.Clear End Sub Хотя я не совсем понимаю, что именно вы здесь делаете, так что это может быть не совсем правильно…