Пробовал с закрытой , открытой , удалял реестр из папки и т.д , ошибка не ушла.
Макрос ругается на сл строчку:
Код
Cells(i, j).Value = mass(i - 1, j)
Хотел сделать редизайнер таблицы. В чем может быть проблема ? Заранее спасибо!
Макрос:
Код
Sub fltbl()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim mass()
lr = ActiveSheet.UsedRange.Rows.Count
lc = ActiveSheet.UsedRange.Columns.Count
ReDim mass(1 To (lr - 3) * (lc - 5), 1 To 7) ' lr-3 - минус 3 первые строки шапки, lc-5 - марки с 6-го столбца, поэтому -5
n = 3 'номер первой строки с названиями марок
For i = 4 To lr ' с четвертой строки начинаем сбор данных
If Cells(i, 3).Value = "" Then
n = i 'следующая строка с марками, когда в третьем столбце пусто
Else
For j = 6 To lc Step 2 ' марки с 6-го столбца
If Cells(n, j).Value <> "" Then
a = a + 1
mass(a, 1) = Cells(i, 1).Value: mass(a, 2) = Cells(i, 2).Value
mass(a, 3) = Cells(i, 3).Value: mass(a, 4) = Cells(i, 4).Value
mass(a, 5) = Cells(i, 5).FormulaLocal: mass(a, 6) = Cells(n, j).Value
mass(a, 7) = Cells(i, j).FormulaLocal
End If
Next
End If
Next
Worksheets.Add
For i = 2 To a + 1
For j = 1 To 7
Cells(i, j).Value = mass(i - 1, j)
Next
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
дополню. Код писал я в одной из предыдущих тем. Массив не пустой. В mass(a, 7) записывается формула со СЧЕТЕСЛИ. При выгрузке ошибка. Причем у меня ошибки нет, формула переносится со значением #VALUE!, у автора ТС не переносится вообще. Формула в mass(a, 5) обрабатывается нормально, там просто ссылка на ячейку в другой книге, без вычислений. Пробовали запускать макрос с открытой книгой, на которую ссылка в СЧЕТЕСЛИ, закрытой, перемещать книгу в другую папку (по аналогии - у меня книги нет, и работает), в общем, танцы с бубном какие-то...
Sub fltbl()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim mass()
lr = ActiveSheet.UsedRange.Rows.Count
lc = ActiveSheet.UsedRange.Columns.Count
ReDim mass(1 To (lr - 3) * (lc - 5), 1 To 7) ' lr-3 - минус 3 первые строки шапки, lc-5 - марки с 6-го столбца, поэтому -5
n = 3 'номер первой строки с названиями марок
For i = 4 To lr ' с четвертой строки начинаем сбор данных
If Cells(i, 3).Value = "" Then
n = i 'следующая строка с марками, когда в третьем столбце пусто
Else
For j = 6 To lc Step 2 ' марки с 6-го столбца
If Cells(n, j).Value <> "" Then
a = a + 1
mass(a, 1) = Cells(i, 1).Value: mass(a, 2) = Cells(i, 2).Value
mass(a, 3) = Cells(i, 3).Value: mass(a, 4) = Cells(i, 4).Value
mass(a, 5) = Cells(i, 5).FormulaLocal: mass(a, 6) = Cells(n, j).Value
mass(a, 7) = Cells(i, j).FormulaLocal
End If
Next
End If
Next
Worksheets.Add
If j = 5 Or j = 7 Then
Cells(i, j).FormulaLocal = mass(i - 1, j)
Else
Cells(i, j).Value = mass(i - 1, j)
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Не понимаю , у меня не работает Где я косячу!?(( Можете скинуть рабочий макрос целиком ? Код:
Код
Sub fltbl()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim mass()
lr = ActiveSheet.UsedRange.Rows.Count
lc = ActiveSheet.UsedRange.Columns.Count
ReDim mass(1 To (lr - 3) * (lc - 5), 1 To 7) ' lr-3 - минус 3 первые строки шапки, lc-5 - марки с 6-го столбца, поэтому -5
n = 3 'номер первой строки с названиями марок
For i = 4 To lr ' с четвертой строки начинаем сбор данных
If Cells(i, 3).Value = "" Then
n = i 'следующая строка с марками, когда в третьем столбце пусто
Else
For j = 6 To lc Step 2 ' марки с 6-го столбца
If Cells(n, j).Value <> "" Then
a = a + 1
mass(a, 1) = Cells(i, 1).Value: mass(a, 2) = Cells(i, 2).Value
mass(a, 3) = Cells(i, 3).Value: mass(a, 4) = Cells(i, 4).Value
mass(a, 5) = Cells(i, 5).FormulaLocal: mass(a, 6) = Cells(n, j).Value
mass(a, 7) = Cells(i, j).FormulaLocal
End If
Next
End If
Next
Worksheets.Add
For j = 1 To 7
If j = 5 Or j = 7 Then
Cells(i, j).FormulaLocal = mass(i - 1, j)
Else
Cells(i, j).Value = mass(i - 1, j)
End If
Next
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub fltbl()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim mass()
lr = ActiveSheet.UsedRange.Rows.Count
lc = ActiveSheet.UsedRange.Columns.Count
ReDim mass(1 To (lr - 3) * (lc - 5), 1 To 7) ' lr-3 - минус 3 первые строки шапки, lc-5 - марки с 6-го столбца, поэтому -5
n = 3 'номер первой строки с названиями марок
For i = 4 To lr ' с четвертой строки начинаем сбор данных
If Cells(i, 3).Value = "" Then
n = i 'следующая строка с марками, когда в третьем столбце пусто
Else
For j = 6 To lc Step 2 ' марки с 6-го столбца
If Cells(n, j).Value <> "" Then
a = a + 1
mass(a, 1) = Cells(i, 1).Value: mass(a, 2) = Cells(i, 2).Value
mass(a, 3) = Cells(i, 3).Value: mass(a, 4) = Cells(i, 4).Value
mass(a, 5) = Cells(i, 5).FormulaLocal: mass(a, 6) = Cells(n, j).Value
mass(a, 7) = Cells(i, j).FormulaLocal
End If
Next
End If
Next
Worksheets.Add
For j = 1 To 7
If j = 5 Or j = 7 Then
Cells(i, j).FormulaLocal = mass(i - 1, j)
Else
Cells(i, j).Value = mass(i - 1, j)
End If
Next
'Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub fltbl()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim mass()
lr = ActiveSheet.UsedRange.Rows.Count
lc = ActiveSheet.UsedRange.Columns.Count
ReDim mass(1 To (lr - 3) * (lc - 5), 1 To 7) ' lr-3 - минус 3 первые строки шапки, lc-5 - марки с 6-го столбца, поэтому -5
n = 3 'номер первой строки с названиями марок
For i = 4 To lr ' с четвертой строки начинаем сбор данных
If Cells(i, 3).Value = "" Then
n = i 'следующая строка с марками, когда в третьем столбце пусто
Else
For j = 6 To lc Step 2 ' марки с 6-го столбца
If Cells(n, j).Value <> "" Then
a = a + 1
mass(a, 1) = Cells(i, 1).Value: mass(a, 2) = Cells(i, 2).Value
mass(a, 3) = Cells(i, 3).Value: mass(a, 4) = Cells(i, 4).Value
mass(a, 5) = Cells(i, 5).FormulaLocal: mass(a, 6) = Cells(n, j).Value
mass(a, 7) = Cells(i, j).FormulaLocal
End If
Next
End If
Next
Worksheets.Add
For i = 2 To a + 1
For j = 1 To 7
If j = 5 Or j = 7 Then
Cells(i, j).FormulaLocal = mass(i - 1, j)
Else
Cells(i, j).Value = mass(i - 1, j)
End If
Next
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub