Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 След.
Макрос переноса динамической таблицы Ексель в закладку открытого документа Ворд, Ошибки объявления переменных и тп
 
С какого уровня вы запускаете код, из Excel или Word ?
У вас есть и "With ActiveDocument" и "Sheets("Dog1").Select" без адресации предыдущего уровня и неизвестно с какой стороны он запускается.
Макрос ошибочно умножает число на 1000
 
В этом случае этот код:
Код
    .Replace What:=".", Replacement:=","
работать не будет (может не работать), попробуйте использовать этот код:
Код
    Dim stlb As Object
    For Each stlb In Columns("D:E")
        stlb.TextToColumns Destination:=stlb.Cells(1), DataType:=xlDelimited, _
        FieldInfo:=Array(1, 1), DecimalSeparator:=".", TrailingMinusNumbers:=True
    Next
Переименование ярлыков листа, изменение нумерации в ярлыках листов
 
Цитата
edkudin написал:
алгоритм вижу так
Так в чем проблема ? Вы уже разработали алгоритм, теперь вам нужно перевести его в код.
Хорошей базой будет код "RAN" (#14), например:
Код
Option Explicit

Sub Knopka1()
    Dim sht As Object, as_sifr, i As Integer, kolist As Integer
    
    'Vypuskniki
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "Menu" And sht.Name <> "Vypuskniki" Then
            as_sifr = Split(sht.Name, "_", -1, 1)
            If IsNumeric(as_sifr(0)) Then
                If as_sifr(0) = 11 Then
                    With Sheets("Vypuskniki")
                        With .Range("B" & .Rows.Count).End(xlUp)
                            sht.Range("B2").CurrentRegion.Copy .Offset(1, 0)
                            Application.CutCopyMode = False
                        End With
                    End With
                    Application.DisplayAlerts = False
                    sht.Delete
                    Application.DisplayAlerts = True
                End If
            End If
        End If
    Next
    ' 2 do 10
    kolist = ThisWorkbook.Worksheets.Count
    For i = kolist To 1 Step -1
        With ThisWorkbook.Worksheets(i)
            If .Name <> "Menu" And .Name <> "Vypuskniki" Then
                as_sifr = Split(.Name, "_", -1, 1)
                If IsNumeric(as_sifr(0)) Then
                    If as_sifr(0) > 1 Then .Name = as_sifr(0) + 1 & "_" & as_sifr(1)
                End If
            End If
        End With
    Next
    'Novyye 1
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "Menu" And sht.Name <> "Vypuskniki" Then
            as_sifr = Split(sht.Name, "_", -1, 1)
            If IsNumeric(as_sifr(0)) Then
                If as_sifr(0) = 1 Then
                    sht.Name = "2" & "_" & as_sifr(1)
                    sht.Copy Before:=sht
                    ActiveSheet.Name = "1" & "_" & as_sifr(1)
                    ActiveSheet.Range("B2").CurrentRegion.ClearContents
                End If
            End If
        End If
    Next
    ThisWorkbook.Sheets("Menu").Select
End Sub
Разделить одну таблицу на несколько для дальнейшей вставки в шаблон WORD
 
Почему 1x27 и 2x36 ?
Зачем нет 3x33 ?
Какой критерий деления ?
Распознание текста в ячейке - как адреса.
 
Если вы имеете в виду номер строки (из символики "F4"), вы можете сделать это так:
Код
Range("H6").Value = Range(Range("R2").Value).Row
Макрос для подстановки формулы из ячейки
 
Потому что "такие" функции не видят символы форматирования.
Апостроф используется для преобразования данного значения в текст.
Выполнийте (через F8) "экспериментальный код" ниже, затем прочитайте о "PrefixCharacter".
Код
Option Explicit

Sub abc_xyz()
    Dim statusTNK
    
    statusTNK = Application.TransitionNavigKeys
    Application.TransitionNavigKeys = False
    
    Range("A1:D1").ClearContents
    Range("A1").Value = "'=C1+D1"
    Range("C1").Value = 1
    Range("D1").Value = 2
    
    If "'" = Range("A1").PrefixCharacter Then
        Range("B1").Formula = Range("A1").Value
    End If
    
    Application.TransitionNavigKeys = statusTNK
End Sub

редакт.:

Не было бы лучше воссоздать ваши формулы из кода VBA или из листа, но без апострофов ?
Пример ниже:
Изменено: ocet p - 16 Апр 2019 23:02:02
Макрос для подстановки формулы из ячейки
 
Цитата
KEKIs написал:
... и дальше сидел рылся, искал, где ошибка, если бы до этого не сделал ...

Сначала организуйте свой код, установте любые (какие-нибудь) теги (хотя бы Debug.Print), которые будут собирать характерные данные для дальнейшего анализа, и только потом "начинайте паниковать" ...  ;)

Например:

Код
Option Explicit

Sub qq()
    Dim shtFEP As Object
    Dim CSal As Integer
    Dim RSal As Long
    Dim frmla As String, frmlaRC As String
    Dim Pos, Div, RMot, CMot, yest
    
    Set shtFEP = ThisWorkbook.Sheets("Fayl EP")
    
    shtFEP.Activate
    
    For RSal = 2 To shtFEP.Cells(shtFEP.Rows.Count, "A").End(xlUp).Row
        Pos = shtFEP.Cells(RSal, "A").Value: Debug.Print Pos
        
        For CSal = 3 To 4
            Div = shtFEP.Cells(1, CSal).Value: Debug.Print Div
            
            With Worksheets("Motyvatsii")
                RMot = Application.Match(Pos, .Range("A1:A1000"), 0): Debug.Print RMot
                If IsError(RMot) Then MsgBox "Oshibka dlya 'Match-RMot'": Exit Sub
                
                CMot = Application.Match(Div, .Range("A1:AAA1"), 0): Debug.Print CMot
                If IsError(CMot) Then MsgBox "Oshibka dlya 'Match-CMot'": Exit Sub
                
                With .Cells(RMot, CMot)
                    frmlaRC = .FormulaR1C1: Debug.Print frmlaRC
                    yest = InStr(1, frmlaRC, Chr(39), vbTextCompare): Debug.Print yest
                    If yest = Null Then MsgBox "Oshibka dlya 'InStr-FormulaR1C1'": Exit Sub
                    
                    yest = yest + 1: Debug.Print yest
                    frmla = Mid(frmlaRC, yest, 1000): Debug.Print frmla
                End With
                
                shtFEP.Cells(RSal, CSal).FormulaR1C1 = frmla
            End With
        Next
    Next
    
    Set shtFEP = Nothing
End Sub

и так далее ...

Прикрепите адекватную формулу (в виде текста) для анализа.

Изменено: ocet p - 15 Апр 2019 18:50:02
Неправильная сортировка по дате
 
Цитата
tayers написал:
файл hsp.csv (так он у меня называется) макрос по прежнему не видит в папке C:\temp
Пожалуйста, запустите этот макрос, что он вам показывает ?
Код
Sub xyz_abc()
    Const pth$ = "C:\Temp\"
    Const fle$ = "hsp.csv"
    If Dir(pth, vbDirectory) = "" Then _
        MsgBox "Net papki": Exit Sub Else MsgBox "Est' papka"
    
    If Dir(pth & fle, vbNormal) = "" Then _
        MsgBox "Net fayla:  " & fle Else MsgBox "Est' fayl"
    If Dir(pth & fle, vbHidden) = "" Then _
        MsgBox "Net fayla:  " & fle Else MsgBox "Est' fayl:  " & fle & "  no on skrytyy"
End Sub
Какой формат даты в вашей системе и какой десятичный разделитель ?
Доделка макроса на исполнение другой функции
 
Like Operator
Characters in pattern Matches in string
=========================================
?   Any single character
*   Zero or more characters
#   Any single digit (0–9)
[charlist]  Any single character in charlist
[!charlist]  Any single character not in charlist


В каких словосочетаниях вы это используете ?
Приведите примеры.
Доделка макроса на исполнение другой функции
 

Я не понимаю схем этой вашей "точности", ведь "*" = "* " = " *", звездочка "*" заменяет любую строку символов или ни одной, если она не существует, поэтому нет необходимости писать "* " или " *", так как это то же самое, что и "*". В каких словосочетаниях вы это используете, приведите пример.

Неправильная сортировка по дате
 

В файле "csv" у вас есть английские/американские настройки (разделители), а какие в вашей системе разделители: дат, списков и десятичный разделитель ?
Если они отличаются, то лучше будет конвертировать файл "csv", прежде чем импортировать его в excel, используя, например свойство "International".

Изменено: ocet p - 5 Апр 2019 06:47:29
Доделка макроса на исполнение другой функции
 
Цитата
Fsociety_ написал:
в моем макросе нужно только изменить последнюю строку
Иногда лучше начать всё с самого начала, часто трудно улучшить чужою кодировку и проще создать свою собственную.
Пожалуйста попробуйте:

Если должно быть с сортировкой, можно сделать таким образом:
Код
Option Explicit

Sub Del_Array_SubStr()
    Dim t!: t = Timer
    Dim lLastRowB As Long, lLastRowC As Long, li As Long, lr As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Application.EnableEvents = False
    
    With Sheets("Лист1")
        lLastRowB = .Cells(.Rows.Count, "B").End(xlUp).Row
        lLastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row
        
        For lr = 5 To lLastRowC
            For li = 5 To lLastRowB
                If LCase(.Range("B" & li).Value) Like "*" & LCase(.Range("C" & lr).Value) & "*" Then
                    .Range("D" & .Rows.Count).End(xlUp).Offset(1, 0).Value = .Range("B" & li).Value
                    .Range("B" & li).Value = ""
                End If
            Next
        Next
        
        .Range("B4:B" & lLastRowB).Sort .Range("B4"), Header:=xlYes
        .Range("D4:D" & .Cells(.Rows.Count, "D").End(xlUp).Row).Sort .Range("D4"), Header:=xlYes
    End With
    
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    
konets: Debug.Print Format(Timer - t, "0.0000")
End Sub
Если без сортировки, то например:
Код
Option Explicit

Sub Del_Array_SubStr()
    Dim t!: t = Timer
    Dim i As Long, j As Long, indB As Long, indC As Long
    Dim arrB(), arrC(), arrD(), pos
    
    With Application
        .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False
        
        With .ThisWorkbook.Sheets("Лист1")
            arrB = .Range("B5:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value: indB = UBound(arrB, 1)
            arrC = .Range("C5:C" & .Cells(.Rows.Count, "C").End(xlUp).Row).Value: indC = UBound(arrC, 1)
            
            For i = 1 To indC
                pos = Application.Match("*" & arrC(i, 1) & "*", arrB, 0)
                If Not IsError(pos) Then
                    j = j + 1: ReDim Preserve arrD(1 To j): arrD(j) = arrB(pos, 1)
                    arrB(pos, 1) = ""
                End If
            Next
            
            If j = 0 Then MsgBox "Нет совпадений": GoTo konets
            Erase arrC: ReDim arrC(1 To indB - j, 1 To 1): j = 0
            
            For i = 1 To indB
                If arrB(i, 1) <> "" Then j = j + 1: arrC(j, 1) = arrB(i, 1)
            Next
            
            .Range("B5:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).ClearContents
            .Range("B5").Resize(j, 1).Value = arrC
            .Range("D" & .Cells(.Rows.Count, "D").End(xlUp).Row + 1).Resize(UBound(arrD), 1).Value = Application.Transpose(arrD)
            Erase arrB: Erase arrC: Erase arrD
        End With
        
        .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True
    End With
    
konets: Debug.Print Format(Timer - t, "0.0000")
End Sub
Исправление бага макроса
 
Ну, к сожалению это не обязательно хорошо работает - есть ошибка. Строка кода:
Код
x.Offset(0, 4).Sort x.Cells(1).Offset(0, 4), Header:=xlYes
сортирует столбец "F", а не "E" - вы должны изменить его на:
Код
x.Offset(0, 3).Sort x.Cells(1).Offset(0, 3), Header:=xlYes
, чтобы отсортировать столбец "E".

... вот, это такая "ночная работа" то была ...
Исправление бага макроса
 
Может быть таким образом ?
Код
Option Explicit

Sub qqq()
    Dim x As Range, y As Range
    
    Sheets("List1").Select
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set x = Range("B4:B10000")
    x.Offset(1, 3).Resize(x.Rows.Count - 1, 1).ClearContents
    x.AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    Set y = x.Offset(1, 0).Resize(x.Rows.Count - 1, 1).SpecialCells(12)
    y.Copy
    [E5].PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ActiveSheet.AutoFilterMode = False
    y.ClearContents
    y.Interior.ColorIndex = xlNone
    x.Sort x.Cells(1), Header:=xlYes
    x.Offset(0, 4).Sort x.Cells(1).Offset(0, 4), Header:=xlYes
    Range("E5").Select
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Создание диапазона чисел между двумя значениями, Подскажите пожалуйста! Имеется такие числа: 52.188960 и 52.774526 Как получить промежуточный диапазон этих чисел ?
 
Или например:
В A1 впишите 52,188960
В B1 впишите 52,774526
В A2 впишите =IF(A$1+ROW(A1)/1000000<=B$1;A$1+ROW(A1)/1000000;"")
и скопировать вниз ...
... и надо вам пойти на пиво, это может занять немножко времени ... что-то около 600 000 строк ... zirka about ...
Изменено: ocet p - 3 Апр 2019 03:13:16
Вставка таблицы в UserForm
 
Например (смотрите файл):
Создание папки макросом при совпадении имён ошибка, Ошибка при совпадении имени папок
 
Пожалуйста, используйте функцию "Dir" которая проверит существование данного каталога, например:
Код
    If Worksheets("SETTINGS").Cells(11, 15).Value = True Then
        papka = ThisWorkbook.Path & "\" & Trim(Sheets("ARX").[N2].Value)
        If Dir(papka, vbDirectory) = "" Then MkDir papka Else MsgBox "Папка с таким именем уже существует": Exit Sub
    End If
Изменено: ocet p - 30 Мар 2019 18:25:02
Удалить СТРОКИ, когда в ячейке попадется серия подряд одинаковых символов больше N
 
... и ещё макрос:
Код
Option Explicit

Sub abc_xyz()
    Dim frgm$, znk$, znch$, dln%, i%, j%, yst%, r&: r = 1
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlManual
    
    Do Until Cells(r, "AC").Value = ""
        znch = LCase(Cells(r, "AC").Value)
        dln = Len(znch) - 3
        For i = 1 To dln
            frgm = Mid(znch, i, 4)
            znk = Mid(frgm, 1, 1)
            yst = 0
            For j = 2 To 4
                If Mid(frgm, j, 1) = znk Then yst = yst + 1
                If yst = 3 Then Exit For
            Next
            If j = 4 Then Exit For
        Next
        If j = 4 Then Rows(r).Delete Else r = r + 1
    Loop
    
    Application.Calculation = xlAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Почему при копировании берутся и скрытые ячейки?
 
Цитата
borro написал:
... где их надо использовать?

Пожалуйста, попробуйте этот способ:
Код
Option Explicit

Sub PasteToVisible_2()
    Dim i As Long, j As Long
    Dim crng As Range, prng As Range, sngarr As Range, rrow As Range
    
    Set crng = Application.InputBox("Diapazon kopirowaniya", "Zapros", "List1!$A$1:$D$4", Type:=8).SpecialCells(xlCellTypeVisible)
    Set prng = Application.InputBox("Diapazon vstavki", "Zapros", "List2!$A$1:$D$4", Type:=8).SpecialCells(xlCellTypeVisible)
    
    i = crng.Columns.Count
    j = prng.Columns.Count
    
    If i <> j Then MsgBox "Raznyy razmer diapazonov: 'Stolbtse' - Konets", vbCritical: Exit Sub
    
    i = 0
    j = 0
    
    For Each sngarr In crng.Areas
        i = i + sngarr.Rows.Count
    Next
    For Each sngarr In prng.Areas
        j = j + sngarr.Rows.Count
    Next
    
    If i <> j Then MsgBox "Raznyy razmer diapazonov: 'Stroki' - Konets", vbCritical: Exit Sub
    
    i = 0
    j = 0
    
    Sheets(prng.Parent.Name).Select
    
    For Each sngarr In crng.Areas
        i = i + 1
        For Each rrow In sngarr.Rows
            j = j + 1
            rrow.Copy prng.Areas(i).Rows(j).Cells(1)
            Application.CutCopyMode = False
        Next
        j = 0
    Next
End Sub
Изменить макрос сравнения с совпадения на различия
 
Второй вариант:
Код
Option Explicit

Sub abc_xyz()
    Dim r As Long, rw As Long, yest
    
    r = 1: rw = 0
    Do Until Cells(r, "B").Value = ""
        yest = Application.Match(Cells(r, "B").Value, Columns("A:A"), 0)
        If TypeName(yest) = "Error" Then rw = rw + 1: Cells(rw, "C").Value = Cells(r, "B").Value
        r = r + 1
    Loop
End Sub
Среднее значение ячеек
 
И ещё вариант для супер ленивых - выделите ячейки и проверьте среднее значение в строке состояния (нижний край окна Excel, "Status Bar"), введите её (значение) в "H2" ... :)
Почему при копировании берутся и скрытые ячейки?
 
Цитата
borro написал:
... SpecialCells(xlCellTypeVisible) ... залезает в скрытые ячейки. Как это можно исправить?
Надо вам использовать "Areas".

Или может хватит только так ?
Код
Sub PasteToVisible_1()
    Dim copyrng As Range, pasterng As Range
    
    Set copyrng = Application.InputBox("Kopirovaniye", "Zapros", Type:=8)
    Set pasterng = Application.InputBox("Vyberite tol'ko odnu yacheyku", "Zapros", Type:=8)
    
    copyrng.SpecialCells(xlCellTypeVisible).Copy Destination:=pasterng.Cells(1)
    Application.CutCopyMode = False
End Sub
Макрос копирования формул, аналог двойного клика в нижний правый угол ячейки
 
Как формулы записываются в ячейки (вручную или кодом/макросом) ?
Какие действия или события должны запустить код макроса копирующего формулы в ячейках ?

Вы можете использовать тоже например: "AutoFill", "FillDown", DataSeries", и т.д.
ошибка сбора
 
Цитата
liny1 написал: я написал код, но получил ошибку
Цитата
liny1 написал: [E2].Value = WorksheetFunction.SumIfs(Range("E2:E25000")
???
круговая ссылка
может вы имеете в виду что то подобное (?):
Код
Sub abc()
    [F2].Formula = _
    "=SumIfs(" & _
    Range("E2:E25000").Address(0, 0) & ", " & _
    Range("A2:A25000").Address(0, 0) & ", " & """>=" & _
    "1/1/2019" & """" & ", " & _
    Range("A2:A25000").Address(0, 0) & ", " & """<=" & _
    "31/1/2019" & """" & ")"
End Sub
Перенос дат со столбца в столбец по критериям, разнести даты в другой столбец по критериям
 
или ... :) ...

E2  =ЕСЛИ(ПРАВСИМВ(B2;1)="О";C2;"")
F2  =ЕСЛИ(ПРАВСИМВ(B2;1)="О";"";C2)
Копировать данные с сайта с помощью VBA
 
Цитата
kleo90 написал:
Cells(0, 1).Value
...
Cells(0, 2).Value
В листе Excel нет строки номер 0.
Удаление строк по условию из массива
 
Когда дело доходит до избавления от "уд", то используйте самый простой 'SQL', например:
Код
strSql = "SELECT * FROM [List1$] WHERE [Zagol3] <> '" & isk & "';"
где 'isk'
Код
Const isk$ = "уд"

"List1" - это название листа,

только вам нужно сначала вставить временные заголовки для данных из "List1" (Zagol1, Zagol2, Zagol3, и так далее), например:

Код
For i = 1 To indc
    ThisWorkbook.Sheets("List1").Cells(1, i).Value = "Zagol" & CStr(i)
Next
а затем 'SQL' в 'QueryTables', например:
Код
With ThisWorkbook.Sheets("List2")
    .Select
    With .QueryTables.Add(Connection:=strCon, Destination:=.Range("A2"), Sql:=strSql)
        .FieldNames = True                    'или False
        .AdjustColumnWidth = False            'или True
        .RefreshStyle = xlInsertEntireRows
        .Refresh BackgroundQuery:=False
        .Delete
    End With
End With
где 'strCon' например:
Код
strCon = "ODBC;DSN=Excel Files;DBQ=" & dbPath & ";"
где 'dbPath' например:
Код
dbPath = ThisWorkbook.FullName
, затем удалите ненужный столбец
Код
ThisWorkbook.Sheets("List2").Columns(nrc).Delete
'или
ThisWorkbook.Sheets("List2").Columns(adrs & ":" & adrs).Delete
где 'nrc' и 'adrs' (поиск столбца с "уд" = 'isk') например:
Код
With ThisWorkbook.Sheets("List1")
    For i = 1 To indc
        If Not IsError(Application.Match(isk, .Columns(i), 0)) Then
            nrc = i                                                         'Номер столбца с "уд"
            adrs = Split(.Columns(i).Cells(1).Address(1, 0), "$", -1, 1)(0) 'Адрес столбца с "уд"
            Exit For
        End If
    Next
End With
где 'indc' например:
Код
indc = ThisWorkbook.Sheets("List1").Range("A2").CurrentRegion.Columns.Count
Удаление строк по условию из массива
 
Цитата
casag написал:
собрать массив из столбцов
Каков на самом деле размер ваших данных в листе, или только столбцы от "A" до "D", или какой-то другой, больший ?

Цитата
casag написал:
удалить столбец, в котором встречается слово "уд"
Но ведь в вашем примере это всегда будет столбец "C" ?

Цитата
casag написал:
и выгрузить результат на Лист2
Если ваш пример достоверный, вы можете сделать это следующим образом:
Код
Option Explicit

Sub ccc()
    Const isk$ = "уд"
    Dim c%, r&, ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets("Лист1")
        r = 2: c = ws.Range("A2").CurrentRegion.Columns.Count
        With .Sheets("Лист2")
            Do Until ws.Cells(r, "A").Value = ""
                If Not Join(Application.Index(ws.Cells(r, "A").Resize(1, c).Value, 0), " ") Like "*" & isk & "*" Then
                    .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Range("A" & r).Value
                    .Range("B" & .Rows.Count).End(xlUp).Offset(0, 1).Value = ws.Range("A" & r).Offset(0, 3).Value
                    .Range("B" & .Rows.Count).End(xlUp).Offset(0, 4).Value = ws.Range("A" & r).Offset(0, 1).Value
                End If
                r = r + 1
            Loop
        End With
    End With
    Set ws = Nothing
End Sub
Пустая строка через каждые 250 строк
 
В конце темы добавлю "свои 3 копейки":
Код
Sub kazhdyye_x_stroki()
    Const shag& = 250
    Dim ur_rws&: ur_rws = ActiveSheet.UsedRange.Rows.Count
    If ur_rws = Rows.Count Then Exit Sub
    If ur_rws < shag Then Exit Sub
    Dim i&, r&, sklk&
    i = 1: r = 0
    sklk = ur_rws \ shag
    On Error Resume Next
    Do Until i = sklk
        r = r + 1 + shag
        Rows(r).Insert Shift:=xlDown
        If Err.Number <> 0 Then Exit Do
        i = i + 1
    Loop
    If Err.Number <> 0 Then Exit Sub
    If Application.CountA(Rows(r + 1 + shag)) <> 0 Then Rows(r + 1 + shag).Insert Shift:=xlDown
End Sub
Пустая строка через каждые 250 строк
 
Цитата
tayers написал:
пустая после каждых 250 строк
Какой столбец является определяющим для измерений ?
По которому нужно считать каждые 250 ?
Страницы: 1 2 3 4 5 6 7 8 След.
Наверх