Answer the question
In order to leave comments, you need to log in
Why does a macro in Excel break?
Good afternoon!
The search for an answer in Russian did not yield results. Searches in English did not give a result, probably due to poor knowledge of the language. I did not look beyond the 40th line in the search results.
The macro operation breaks at any time (or does not break) without any error messages on the same section of code. The problem is observed on both 32-bit and 64-bit (according to the end user) versions of Excel 2016.
The macro takes data from a file, enriches it through a request from the server, cuts it into 200-250 small xlsx files, writes to two summary files in parallel and sends everything to the recipients. The problem always occurs during cutting into files.
Option Explicit
Sub macros_name()
Dim c As Integer
Dim i, j, o As Long
Dim some_code, small_file, file_total_data, created_file As String
Dim FSO, work_folder, work_file, dict_target, dict_another As Object
Dim l_inc_data, l_out As Workbook
'Как я узнал тут (https://qna.habr.com/q/1071426), _
часть переменных объявлена как Variant из-за перечисления через запятую.
Application.DisplayStatusBar = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set work_folder = FSO.GetFolder(ThisWorkbook.Path)
On Error Resume Next
If l_input.AutoFilterMode Then l_input.ShowAllData
If l_main.AutoFilterMode Then l_main.ShowAllData
If l_data.AutoFilterMode Then l_data.ShowAllData
On Error GoTo 0
'Здесь забираются данные из файла. 10 колонок и около 2000 строк. Здесь всегда всё хорошо.
If Len(l_input.Cells(2, 1).Value) > 0 Then
j = l_main.Cells(l_main.Rows.Count, 1).End(xlUp).Row + 1
For i = 2 To l_input.Cells(l_input.Rows.Count, 1).End(xlUp).Row
l_main.Cells(j, 8).NumberFormat = "@"
l_main.Cells(j, 11).NumberFormat = "@"
For c = 1 To 10
l_main.Cells(j, c).Value = l_input.Cells(i, c).Value
Next c
some_code = add_data(args) 'тут функцию менял на ГСЧ - без толку.
l_main.Cells(j, 11).Value = some_code
If Len(l_main.Cells(j, 11).Value) > 0 _
And dict_target(l_main.Cells(j, 11).Value) <> "no data" Then
l_main.Cells(j, 12).Value = dict_another.Item(l_main.Cells(j, 11).Value)
small_file = ThisWorkbook.Path & "\part_of_name" & some_code & " " & Date & ".xlsx"
file_total_data = ThisWorkbook.Path & "\part_of_name" & l_main.Cells(j, 12).Value & " " _
& Date & ".xlsx"
'crate_new_file создаёт новый файл xlsx, делает заголовки колонок и закрывает файл.
If Not FSO.FileExists(small_file) Then Call crate_new_file(small_file, False, row_log)
If Not FSO.FileExists(file_total_data) Then Call crate_new_file(file_total_data, True, row_log)
Set l_out = Application.Workbooks.Open(Filename:=small_file)
o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
For c = 1 To 10
l_out.Sheets(1).Cells(o, c).Value = l_input.Cells(i, c).Value
Next c
l_out.Close True
Set l_out = Application.Workbooks.Open(Filename:=file_total_data)
o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
For c = 1 To 10
l_out.Sheets(1).Cells(o, c).Value = l_input.Cells(i, c).Value
Next c
l_out.Close True
End If
j = j + 1
Next i
End If
'Здесь макрос делает остальные задачи. Тут тоже всегда всё хорошо.
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
....
Dim cells_to_copy As Range
....
If Len(l_input.Cells(2, 1).Value) > 0 Then
j = l_main.Cells(l_main.Rows.Count, 1).End(xlUp).Row + 1
For i = 2 To l_input.Cells(l_input.Rows.Count, 1).End(xlUp).Row
l_main.Cells(j, 8).NumberFormat = "@"
l_main.Cells(j, 11).NumberFormat = "@"
Set cells_to_copy = l_input.Range(l_input.Cells(i, 1), l_input.Cells(i, 10))
l_main.Range(l_main.Cells(j, 1), l_main.Cells(j, 10)).Value = cells_to_copy.Value
some_code = add_data(args) 'тут функцию менял на ГСЧ - без толку.
l_main.Cells(j, 11).Value = some_code
If Len(l_main.Cells(j, 11).Value) > 0 _
And dict_target(l_main.Cells(j, 11).Value) <> "no data" Then
l_main.Cells(j, 12).Value = dict_another.Item(l_main.Cells(j, 11).Value)
small_file = ThisWorkbook.Path & "\part_of_name" & some_code & " " & Date & ".xlsx"
file_total_data = ThisWorkbook.Path & "\part_of_name" & l_main.Cells(j, 12).Value & " " _
& Date & ".xlsx"
If Not FSO.FileExists(small_file) Then Call crate_new_file(small_file, False, row_log)
If Not FSO.FileExists(file_total_data) Then Call crate_new_file(file_total_data, True, row_log)
Set l_out = Application.Workbooks.Open(Filename:=small_file)
o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
output_data.Sheets(1).Range( _
output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
).NumberFormat = "@"
output_data.Sheets(1).Range( _
output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
).Value = copied_data.Value
l_out.Close True
Set l_out = Nothing
Set l_out = Application.Workbooks.Open(Filename:=file_total_data)
o = l_out.Sheets(1).Cells(l_out.Sheets(1).Rows.Count, 1).End(xlUp).Row + 1
output_data.Sheets(1).Range( _
output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
).NumberFormat = "@"
output_data.Sheets(1).Range( _
output_data.Sheets(1).Cells(current_row, 1), output_data.Sheets(1).Cells(current_row, output_data.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column) _
).Value = copied_data.Value
l_out.Sheets(1).Cells(o, 11).Value = some_code
l_out.Close True
Set l_out = Nothing
End If
Set cells_to_copy = Nothing
j = j + 1
Next i
End If
Answer the question
In order to leave comments, you need to log in
As what first caught my eye
- perhaps swears at too long paths of newly created files.
- remove On Error GoTo 0 and see where to stop.
- add DoEvents "accidentally" scattered throughout the code.
- describe _all_ variables, perhaps something unexpected appears somewhere in them, Variant is quite insidious.
Didn't find what you were looking for?
Ask your questionAsk a Question
731 491 924 answers to any question