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

Вход

Регистрация

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

 

= Мир MS Excel/Выполнение макроса на все листы документа - Мир MS Excel

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

Здравствуйте, прошу подсказать, как можно усовершенствовать макрос, чтобы он выполнялся на все листы документа?
Спасибо большое за помощь!
[vba]
Код
Sub Redesigner()
    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out() As String, dataArr, hcArr, hrArr
    
     Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="¬ыберите обрабатываемый диапазон:", Title:="¬ыбор диапазона", Type:=8)
    
   hr = Val(InputBox("—колько строк с подпис€ми сверху?"))
   hc = Val(InputBox("—колько столбцов с подпис€ми слева?"))

   
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                k = k + 1
                For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
                For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
                out(k, c + r - 1) = dataArr(i, j)
            End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
    
End Sub
[/vba]
 
Ответить
СообщениеЗдравствуйте, прошу подсказать, как можно усовершенствовать макрос, чтобы он выполнялся на все листы документа?
Спасибо большое за помощь!
[vba]
Код
Sub Redesigner()
    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out() As String, dataArr, hcArr, hrArr
    
     Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="¬ыберите обрабатываемый диапазон:", Title:="¬ыбор диапазона", Type:=8)
    
   hr = Val(InputBox("—колько строк с подпис€ми сверху?"))
   hc = Val(InputBox("—колько столбцов с подпис€ми слева?"))

   
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                k = k + 1
                For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
                For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
                out(k, c + r - 1) = dataArr(i, j)
            End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
    
End Sub
[/vba]

Автор - Gef343
Дата добавления - 27.05.2022 в 15:55
Serge_007 Дата: Пятница, 27.05.2022, 15:58 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 15574
Репутация: 2559 ±
Замечаний: ±

Excel 2016
Здравствуйте

http://www.excelworld.ru/publ/vba/cycles/for_each_next/57-1-0-112, пример №1:
[vba]
Код
Sub example1 ()  
Dim x As Worksheet  
For Each x In ThisWorkbook.Worksheets  
Call Redesigner
Next x  
End Sub  
[/vba]


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеЗдравствуйте

http://www.excelworld.ru/publ/vba/cycles/for_each_next/57-1-0-112, пример №1:
[vba]
Код
Sub example1 ()  
Dim x As Worksheet  
For Each x In ThisWorkbook.Worksheets  
Call Redesigner
Next x  
End Sub  
[/vba]

Автор - Serge_007
Дата добавления - 27.05.2022 в 15:58
Gef343 Дата: Пятница, 27.05.2022, 16:05 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 20% ±



Ага, учел ваш сайт, попробовал изменить, но все равно по одному листу только работает, пытается пойти дальше но дает ошибку
[vba]
Код
Sub example1()

    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out() As String, dataArr, hcArr, hrArr
    Dim x As Worksheet

    Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="Выберите обрабатываемый диапазон:", Title:="Выбор диапазона", Type:=8)
    
   hr = Val(InputBox("Сколько строк с подписями сверху?"))
   hc = Val(InputBox("Сколько столбцов с подписями слева?"))
   
   For Each x In ThisWorkbook.Worksheets()
    
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                k = k + 1
                For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
                For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
                out(k, c + r - 1) = dataArr(i, j)
            End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
Next x
End Sub

[/vba]
 
Ответить
Сообщение

Ага, учел ваш сайт, попробовал изменить, но все равно по одному листу только работает, пытается пойти дальше но дает ошибку
[vba]
Код
Sub example1()

    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out() As String, dataArr, hcArr, hrArr
    Dim x As Worksheet

    Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="Выберите обрабатываемый диапазон:", Title:="Выбор диапазона", Type:=8)
    
   hr = Val(InputBox("Сколько строк с подписями сверху?"))
   hc = Val(InputBox("Сколько столбцов с подписями слева?"))
   
   For Each x In ThisWorkbook.Worksheets()
    
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                k = k + 1
                For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
                For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
                out(k, c + r - 1) = dataArr(i, j)
            End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
Next x
End Sub

[/vba]

Автор - Gef343
Дата добавления - 27.05.2022 в 16:05
Gef343 Дата: Пятница, 27.05.2022, 16:21 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 20% ±

он каждый раз вызывает макрос, а нужно чтоб один раз и на все листы использовался


Сообщение отредактировал Serge_007 - Пятница, 27.05.2022, 17:12
 
Ответить
Сообщениеон каждый раз вызывает макрос, а нужно чтоб один раз и на все листы использовался

Автор - Gef343
Дата добавления - 27.05.2022 в 16:21
Serge_007 Дата: Пятница, 27.05.2022, 17:15 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 15574
Репутация: 2559 ±
Замечаний: ±

Excel 2016
чтоб один раз и на все листы использовался
И как Вы себе это представляете? Как Вы собрались вводить через InputBox кол-во строк и столбцов для всех листов сразу, если оно на каждом листе разное (иначе зачем InputBox)?


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
чтоб один раз и на все листы использовался
И как Вы себе это представляете? Как Вы собрались вводить через InputBox кол-во строк и столбцов для всех листов сразу, если оно на каждом листе разное (иначе зачем InputBox)?

Автор - Serge_007
Дата добавления - 27.05.2022 в 17:15
msi2102 Дата: Пятница, 27.05.2022, 17:17 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 247
Репутация: 90 ±
Замечаний: 0% ±

Excel 2007
 
Ответить
СообщениеКРОСС

Автор - msi2102
Дата добавления - 27.05.2022 в 17:17
RAN Дата: Пятница, 27.05.2022, 17:29 | Сообщение № 7
Группа: Друзья
Ранг: Экселист
Сообщений: 5640
Репутация: 1145 ±
Замечаний: 0% ±

2010
Gef343, вам же объяснили, что
Цитата
ехать на автомобиле одновременно на работу, в отпуск к морю, в магазин за новым креслом и на рынок за мангалом.
, нельзя.
Или вы думаете, что нельзя только на том сайте, а на этом можно? yes


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеGef343, вам же объяснили, что
Цитата
ехать на автомобиле одновременно на работу, в отпуск к морю, в магазин за новым креслом и на рынок за мангалом.
, нельзя.
Или вы думаете, что нельзя только на том сайте, а на этом можно? yes

Автор - RAN
Дата добавления - 27.05.2022 в 17:29
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выполнение макроса на все листы документа (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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