соединить несколько макросов

Дата: Четверг, 21.07.2022, 17:06 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 60

Репутация: 0 ±

Замечаний: 20% ±

У меня вопрос по соединению макросов для выполнения на разных листах. есть макрос по переносу таблиц из эксель в ворд, тему создавала natanata12, Там у неё ошибки, но я поправил. А у меня вопрос можно ли в выполнении её макроса добавить другие макросы?
Макрос там работает: открывается документ ворд - из экселя переносятся таблицы - вставляясь по определённой закладке.
Мне же надо: с одного листа запустить макрос, лист "Т." оставить как есть, а остальные предварительно обработать, убрать ноли и далее удалить пустые строки (все макросы имеются в файле, рабочие) и обработанные таблицы вставить в ворд. Сам попытался (макрос попытка, в файле, там проблема с переменными), но знаний не хватает.

К сообщению приложен файл: 8518673.xlsm (18.8 Kb)

Дата: Четверг, 21.07.2022, 17:41 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Можно так попробовать доработать Ваш макрос
[vba]

Код

Sub попытка()
    Dim i As Integer, j As Integer, k As Integer
    Dim myWord As New Word.Application, myDoc As Word.Document
    Set myDoc = myWord.Documents.Open("C:\Users\Desktop\стр.docx")
    For k = 2 To 4
        With Sheets(k)
            For j = 1 To 10
                For i = 1 To 10
                    If .Cells(i, j) <> "" And .Cells(i, j) = 0 Then
                        .Cells(i, j) = Empty
                    End If
                Next i
            Next j
            .Range("A1").CurrentRegion.Copy
            myDoc.Bookmarks("закладка" & k).Range.PasteExcelTable False, False, False   'имена закладок - закладка2, закладка3, закладка4
        End With
    Next k
End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 21.07.2022, 18:35 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 60

Репутация: 0 ±

Замечаний: 20% ±

Pelena, я решил немного другим путём пойти. С начало решил необходимые листы привести в надлежащий порядок[vba]

Код

Sub удалноль()
Dim iList As Variant
Dim i As Integer
iList = Array("ПБ", "прил", "сод")
  For i = 0 To UBound(iList)
  Sheets(iList(i)).Activate
For j = 1 To 10
        For a = 1 To 10
            While Cells(a, j) <> "" And Cells(a, j) = 0
               Cells(a, j) = Empty
            Wend
        Next a
    Next j
  Next

End Sub

[/vba]
и вот со следующим загвоздка [vba]

Код

Sub удалстрока()
Dim iList As Variant
Dim i As Integer
iList = Array("ПБ", "прил", "сод")
  For i = 0 To UBound(iList)
  Sheets(iList(i)).Activate
Dim r As Long, rng As Range
    For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
        If Application.CountA(Rows(r)) = 0 Then
            If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r))
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete
  Next

End Sub

[/vba] ругается на
[vba]

Код

Set rng = Union(rng, Rows(r))

[/vba]
помогите с этим кодом (полное выполнение только на листе "ПБ"),...
и далее поставлю код натаната12

Сообщение отредактировал AB0885 - Четверг, 21.07.2022, 18:37

Дата: Четверг, 21.07.2022, 18:54 | Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

В начале цикла после строки
[vba]

Код

For i = 0 To UBound(iList)

[/vba]
добавьте
[vba]

Код

Set rng=Nothing

[/vba]
иначе получается, что вы пытаетесь объединить строки с разных листов

Ну и строку
[vba]

Код

Dim r As Long, rng As Range

[/vba]
лучше вынести из цикла

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Четверг, 21.07.2022, 19:19 | Сообщение № 5

Группа: Пользователи

Ранг: Участник

Сообщений: 60

Репутация: 0 ±

Замечаний: 20% ±

Pelena,

Цитата

лучше вынести из цикла

, я только начинаю знакомство с VBA и смотрю как делают другие, сам пытаюсь и точно не смогу поправить. Подскажите как лучше вывести из цикла? (после поправок ругаться стало на эту строчку).

Дата: Четверг, 21.07.2022, 19:38 | Сообщение № 6

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

[vba]

Код

Sub удалстрока()
    Dim iList As Variant
    Dim i As Integer
    Dim r As Long, rng As Range
    iList = Array("ПБ", "прил", "сод")
    For i = 0 To UBound(iList)
        Set rng = Nothing
        Sheets(iList(i)).Activate
        For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
            If Application.CountA(Rows(r)) = 0 Then
                If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r))
            End If
        Next r
        If Not rng Is Nothing Then rng.Delete
    Next

End Sub

[/vba]
или более быстрый вариант без активации каждого листа
[vba]

Код

Sub удалстрока1()
    Dim iList As Variant
    Dim i As Integer
    Dim r As Long, rng As Range
    iList = Array("ПБ", "прил", "сод")
    For i = 0 To UBound(iList)
        Set rng = Nothing
        With Sheets(iList(i))
            For r = 1 To .UsedRange.Row - 1 + .UsedRange.Rows.Count
                If Application.CountA(.Rows(r)) = 0 Then
                    If rng Is Nothing Then Set rng = .Rows(r) Else Set rng = Union(rng, .Rows(r))
                End If
            Next r
            If Not rng Is Nothing Then rng.Delete
        End With
    Next
End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Пятница, 22.07.2022, 09:29 | Сообщение № 7

Группа: Пользователи

Ранг: Участник

Сообщений: 60

Репутация: 0 ±

Замечаний: 20% ±

Здравствуйте, Pelena. Всё соединил, работает. У меняя появился вопрос в связи с количеством листов обрабатываемых макросом "удалноль" время на обработку увеличилось. В макросе заданы определённые параметры обработки 10 ячеек на 10 ячеек, а есть возможность оптимизировать? Путём задачи листам, разные диапазоны обработки ячеек или другой путь?

P.S. Надеюсь мои вопросы в рамках данной темы.

Дата: Пятница, 22.07.2022, 15:53 | Сообщение № 8

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Попробуйте так
[vba]

Код

Sub удалноль()
Dim iList As Variant
Dim i As Integer, j As Integer, a As Integer
iList = Array("ПБ", "прил", "сод")
For i = 0 To UBound(iList)
With Sheets(iList(i))
For j = 1 To .UsedRange.Column - 1 + .UsedRange.Columns.Count
        For a = 1 To .UsedRange.Row - 1 + .UsedRange.Rows.Count
            If  .Cells(a, j) = 0 Then  .Cells(a, j).ClearContents
        Next a
    Next j
End With
Next

End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Пятница, 22.07.2022, 17:56 | Сообщение № 9

Группа: Пользователи

Ранг: Участник

Сообщений: 60

Репутация: 0 ±

Замечаний: 20% ±

Pelena, ругается на [vba]

Код

.Cells(a, j).ClearContents

[/vba]
ошибку выдаёт 1004. по объединённым ячейкам
думаю надо вернуть [vba]

Код

Cells(a, j) = Empty

[/vba]
но куда?
самостоятельно попытался у меня в бесконечный цикл ушёл

Сообщение отредактировал AB0885 - Пятница, 22.07.2022, 17:58

Дата: Пятница, 22.07.2022, 18:12 | Сообщение № 10

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

вместо [vba]

Код

.Cells(a, j).ClearContents

[/vba] напишите [vba]

Код

Cells(a, j) = Empty

[/vba]

Цитата AB0885, 22.07.2022 в 17:56, в сообщении № 9 (

)

в бесконечный цикл ушёл

я убрала цикл While, он не нужен. Других бесконечных циклов вроде нет

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Дата: Воскресенье, 24.07.2022, 15:06 | Сообщение № 11

Группа: Пользователи

Ранг: Участник

Сообщений: 60

Репутация: 0 ±

Замечаний: 20% ±

Здравствуйте, Pelena. Я наконец выстроил необходимую структуру листов и запустил этот[vba]

Код

Sub удалноль()
Dim iList As Variant
Dim i As Integer, j As Integer, a As Integer
iList = Array("ПБ", "прил", "сод")
For i = 0 To UBound(iList)
With Sheets(iList(i))
For j = 1 To .UsedRange.Column - 1 + .UsedRange.Columns.Count
        For a = 1 To .UsedRange.Row - 1 + .UsedRange.Rows.Count
            If  .Cells(a, j) = 0 Then  .Cells(a, j) = Empty
        Next a
    Next j
End With
Next

End Sub

[/vba]
когда время работы превысило вдвое я всё остановил. Оптимизации работы макроса не вышло.