Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/соединить несколько макросов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » соединить несколько макросов (Макросы/Sub)
соединить несколько макросов
AB0885 Дата: Четверг, 21.07.2022, 17:06 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 0 ±
Замечаний: 20% ±

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

Автор - AB0885
Дата добавления - 21.07.2022 в 17:06
Pelena Дата: Четверг, 21.07.2022, 17:41 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 18492
Репутация: 4185 ±
Замечаний: ±

Excel 2016 & 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
 
Ответить
СообщениеМожно так попробовать доработать Ваш макрос
[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]

Автор - Pelena
Дата добавления - 21.07.2022 в 17:41
AB0885 Дата: Четверг, 21.07.2022, 18:35 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 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
 
Ответить
Сообщение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:35
Pelena Дата: Четверг, 21.07.2022, 18:54 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 18492
Репутация: 4185 ±
Замечаний: ±

Excel 2016 & 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
 
Ответить
СообщениеВ начале цикла после строки
[vba]
Код
For i = 0 To UBound(iList)
[/vba]
добавьте
[vba]
Код
Set rng=Nothing
[/vba]
иначе получается, что вы пытаетесь объединить строки с разных листов

Ну и строку
[vba]
Код
Dim r As Long, rng As Range
[/vba]
лучше вынести из цикла

Автор - Pelena
Дата добавления - 21.07.2022 в 18:54
AB0885 Дата: Четверг, 21.07.2022, 19:19 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 0 ±
Замечаний: 20% ±

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

Автор - AB0885
Дата добавления - 21.07.2022 в 19:19
Pelena Дата: Четверг, 21.07.2022, 19:38 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 18492
Репутация: 4185 ±
Замечаний: ±

Excel 2016 & 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
 
Ответить
Сообщение[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]

Автор - Pelena
Дата добавления - 21.07.2022 в 19:38
AB0885 Дата: Пятница, 22.07.2022, 09:29 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 0 ±
Замечаний: 20% ±

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

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

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

Автор - AB0885
Дата добавления - 22.07.2022 в 09:29
Pelena Дата: Пятница, 22.07.2022, 15:53 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 18492
Репутация: 4185 ±
Замечаний: ±

Excel 2016 & 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
 
Ответить
СообщениеПопробуйте так
[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]

Автор - Pelena
Дата добавления - 22.07.2022 в 15:53
AB0885 Дата: Пятница, 22.07.2022, 17:56 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 0 ±
Замечаний: 20% ±

Pelena, ругается на [vba]
Код
.Cells(a, j).ClearContents
[/vba]
ошибку выдаёт 1004. по объединённым ячейкам
думаю надо вернуть [vba]
Код
Cells(a, j) = Empty
[/vba]
но куда?
самостоятельно попытался у меня в бесконечный цикл ушёл


Сообщение отредактировал AB0885 - Пятница, 22.07.2022, 17:58
 
Ответить
СообщениеPelena, ругается на [vba]
Код
.Cells(a, j).ClearContents
[/vba]
ошибку выдаёт 1004. по объединённым ячейкам
думаю надо вернуть [vba]
Код
Cells(a, j) = Empty
[/vba]
но куда?
самостоятельно попытался у меня в бесконечный цикл ушёл

Автор - AB0885
Дата добавления - 22.07.2022 в 17:56
Pelena Дата: Пятница, 22.07.2022, 18:12 | Сообщение № 10
Группа: Админы
Ранг: Местный житель
Сообщений: 18492
Репутация: 4185 ±
Замечаний: ±

Excel 2016 & Mac Excel
вместо [vba]
Код
.Cells(a, j).ClearContents
[/vba] напишите [vba]
Код
Cells(a, j) = Empty
[/vba]
в бесконечный цикл ушёл
я убрала цикл While, он не нужен. Других бесконечных циклов вроде нет


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщениевместо [vba]
Код
.Cells(a, j).ClearContents
[/vba] напишите [vba]
Код
Cells(a, j) = Empty
[/vba]
в бесконечный цикл ушёл
я убрала цикл While, он не нужен. Других бесконечных циклов вроде нет

Автор - Pelena
Дата добавления - 22.07.2022 в 18:12
AB0885 Дата: Воскресенье, 24.07.2022, 15:06 | Сообщение № 11
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 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]
когда время работы превысило вдвое я всё остановил. Оптимизации работы макроса не вышло.
 
Ответить
СообщениеЗдравствуйте, 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]
когда время работы превысило вдвое я всё остановил. Оптимизации работы макроса не вышло.

Автор - AB0885
Дата добавления - 24.07.2022 в 15:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » соединить несколько макросов (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!