вечер добрый, для упрощения введения данных в таблицу нужен макрос вставляющий группу строк с листа Шаблоны, групп несколько (отмечаются в столбце признак), требуется что б выбрал из списка нужную группу, нажал и вставились строки... помогите пожалуйста
вечер добрый, для упрощения введения данных в таблицу нужен макрос вставляющий группу строк с листа Шаблоны, групп несколько (отмечаются в столбце признак), требуется что б выбрал из списка нужную группу, нажал и вставились строки... помогите пожалуйстаExtybr
doober, подскажите пожалуйста а как ускорить работу макроса...в оригинальной таблице под 100 столбцов и строк несколько десятков тысяч...после нажатия кнопки крутит сек 20 пока вставит. пробовал для проверки - удалил все другие макросы усл форматир..все равно тупит. в чем может быть дело?
doober, подскажите пожалуйста а как ускорить работу макроса...в оригинальной таблице под 100 столбцов и строк несколько десятков тысяч...после нажатия кнопки крутит сек 20 пока вставит. пробовал для проверки - удалил все другие макросы усл форматир..все равно тупит. в чем может быть дело?Extybr
Ускорить можно только вставкой через массив, а не по строкам[vba]
Код
Private Sub CommandButton1_Click() If ComboBox1.ListIndex = -1 Then Exit Sub Dim res(), pz& Application.ScreenUpdating = False признак = ComboBox1.Value Set Tbl1 = Me.ListObjects(1) Set Tbl2 = ThisWorkbook.Worksheets("Шаблоны").ListObjects(1) pz = 0 dx = Tbl2.DataBodyRange Col = Tbl2.ListColumns("признак").Index ReDim res(1 To UBound(dx), 1 To UBound(dx, 2)) For i = 1 To UBound(dx) If dx(i, Col) = признак Then pz = pz + 1 For n = 1 To UBound(dx, 2) res(pz, n) = dx(i, n) Next End If Next If pz > 0 Then Tbl1.ListRows(Tbl1.ListRows.Count).Range.Cells(1, 1).Offset(1, 0).Resize(pz, UBound(res, 2)) = res End If Application.ScreenUpdating = True End Sub
[/vba]
Ускорить можно только вставкой через массив, а не по строкам[vba]
Код
Private Sub CommandButton1_Click() If ComboBox1.ListIndex = -1 Then Exit Sub Dim res(), pz& Application.ScreenUpdating = False признак = ComboBox1.Value Set Tbl1 = Me.ListObjects(1) Set Tbl2 = ThisWorkbook.Worksheets("Шаблоны").ListObjects(1) pz = 0 dx = Tbl2.DataBodyRange Col = Tbl2.ListColumns("признак").Index ReDim res(1 To UBound(dx), 1 To UBound(dx, 2)) For i = 1 To UBound(dx) If dx(i, Col) = признак Then pz = pz + 1 For n = 1 To UBound(dx, 2) res(pz, n) = dx(i, n) Next End If Next If pz > 0 Then Tbl1.ListRows(Tbl1.ListRows.Count).Range.Cells(1, 1).Offset(1, 0).Resize(pz, UBound(res, 2)) = res End If Application.ScreenUpdating = True End Sub