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

Вход

Регистрация

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

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выполнение макросов по списку в таблице (Макросы/Sub)
Выполнение макросов по списку в таблице
ПутинВВ Дата: Пятница, 25.01.2019, 07:41 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте.
У меня есть код выполнения макросов по списку в столбце по их названию.
Однако если таких столбцов будет два - тут макросу уже надо будет идти по зигзагообразной схеме - построчно.

Подскажите как изменить имеющийся макрос, чтобы он обрабатывал не отдельно каждый из столбцов с макросами по очереди (Q6:Q25 и Z6:Z25), а построчно - как таблицу ?
К сообщению приложен файл: 111.xls(76.5 Kb)
 
Ответить
СообщениеЗдравствуйте.
У меня есть код выполнения макросов по списку в столбце по их названию.
Однако если таких столбцов будет два - тут макросу уже надо будет идти по зигзагообразной схеме - построчно.

Подскажите как изменить имеющийся макрос, чтобы он обрабатывал не отдельно каждый из столбцов с макросами по очереди (Q6:Q25 и Z6:Z25), а построчно - как таблицу ?

Автор - ПутинВВ
Дата добавления - 25.01.2019 в 07:41
krosav4ig Дата: Пятница, 25.01.2019, 08:37 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1851
Репутация: 795 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
[vba]
Код
    Dim i&, j As Variant
    With ActiveSheet.UsedRange
        With Intersect(.Offset(5), .Cells)
            arr = .Value
            For i = LBound(arr, 1) To UBound(arr, 1)
                For Each j In Array(17, 26)
                    Macr = arr(i, j - .Column + 1)
                    If Macr <> "" Then
                        Application.Run Macr
                        Application.Wait Now + #12:00:05 AM#
                    End If
            Next j, i
        End With
    End With
[/vba]или[vba]
Код
    Dim r As Range, col As Variant
    With ActiveSheet.UsedRange
        With Intersect(.Offset(5), .Cells)
            For Each r In .Rows
                For Each col In Array("Q", "Z")
                    Macr = r.Columns(col).Value
                    If Macr <> "" Then
                        Application.Run Macr
                        Application.Wait Now + #12:00:05 AM#
                    End If
            Next col, r
        End With
    End With
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте.
[vba]
Код
    Dim i&, j As Variant
    With ActiveSheet.UsedRange
        With Intersect(.Offset(5), .Cells)
            arr = .Value
            For i = LBound(arr, 1) To UBound(arr, 1)
                For Each j In Array(17, 26)
                    Macr = arr(i, j - .Column + 1)
                    If Macr <> "" Then
                        Application.Run Macr
                        Application.Wait Now + #12:00:05 AM#
                    End If
            Next j, i
        End With
    End With
[/vba]или[vba]
Код
    Dim r As Range, col As Variant
    With ActiveSheet.UsedRange
        With Intersect(.Offset(5), .Cells)
            For Each r In .Rows
                For Each col In Array("Q", "Z")
                    Macr = r.Columns(col).Value
                    If Macr <> "" Then
                        Application.Run Macr
                        Application.Wait Now + #12:00:05 AM#
                    End If
            Next col, r
        End With
    End With
[/vba]

Автор - krosav4ig
Дата добавления - 25.01.2019 в 08:37
K-SerJC Дата: Пятница, 25.01.2019, 08:45 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 368
Репутация: 53 ±
Замечаний: 0% ±

Excel 2013
можно так



Благими намерениями выстелена дорога в АД.

Сообщение отредактировал K-SerJC - Пятница, 25.01.2019, 08:45
 
Ответить
Сообщениеможно так


Автор - K-SerJC
Дата добавления - 25.01.2019 в 08:45
ПутинВВ Дата: Пятница, 25.01.2019, 19:23 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, оба кода не работают.

Выдают одинаковую ошибку:
Run-time error 1004. Method Range of object Global failed.
 
Ответить
Сообщениеkrosav4ig, оба кода не работают.

Выдают одинаковую ошибку:
Run-time error 1004. Method Range of object Global failed.

Автор - ПутинВВ
Дата добавления - 25.01.2019 в 19:23
ПутинВВ Дата: Пятница, 25.01.2019, 19:25 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
K-SerJC, код не работает.

Выдает ошибку:
Run-time error 1004. Method Run of object Application failed.
 
Ответить
СообщениеK-SerJC, код не работает.

Выдает ошибку:
Run-time error 1004. Method Run of object Application failed.

Автор - ПутинВВ
Дата добавления - 25.01.2019 в 19:25
K-SerJC Дата: Вторник, 12.02.2019, 15:47 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 368
Репутация: 53 ±
Замечаний: 0% ±

Excel 2013
Цитата ПутинВВ, 25.01.2019 в 19:25, в сообщении № 5 ()
K-SerJC, код не работает.

доброго дня!
[vba]
Код
Sub Овал1_Щелчок()
Dim arr As Collection, x, t, i
Set arr = New Collection
For Each x In Range(Cells(6, 17), Cells(Rows.Count, 17).End(xlUp))
arr.Add x.Value
arr.Add ActiveSheet.Cells(x.Row, 9 + x.Column).Value
Next x
    'arr = Range(Cells(6, 17), Cells(Rows.Count, 17).End(xlUp)).Value
        For i = 1 To arr.Count
            If Not IsEmpty(arr(i)) Then
                If i / 2 = Int(i / 2) Then Macr = "J" & (5 + i) Else Macr = "S" & (5 + i)
                Application.Run arr.Item(i)
                t = Now + TimeValue("0:00:05")
                    Do
                        DoEvents
                    Loop While t > Now
            End If
        Next i
Set arr = Nothing
End Sub
[/vba]

код выдал ошибку при выполнении макроса (Макрос4())
не найден объект
стоп на строке
[vba]
Код
     Set shp = ActiveSheet.Shapes.AddPicture(Range(Macr), False, True, -1, -1, -1, -1)
[/vba]
перебор у меня отработал корректно


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщение
Цитата ПутинВВ, 25.01.2019 в 19:25, в сообщении № 5 ()
K-SerJC, код не работает.

доброго дня!
[vba]
Код
Sub Овал1_Щелчок()
Dim arr As Collection, x, t, i
Set arr = New Collection
For Each x In Range(Cells(6, 17), Cells(Rows.Count, 17).End(xlUp))
arr.Add x.Value
arr.Add ActiveSheet.Cells(x.Row, 9 + x.Column).Value
Next x
    'arr = Range(Cells(6, 17), Cells(Rows.Count, 17).End(xlUp)).Value
        For i = 1 To arr.Count
            If Not IsEmpty(arr(i)) Then
                If i / 2 = Int(i / 2) Then Macr = "J" & (5 + i) Else Macr = "S" & (5 + i)
                Application.Run arr.Item(i)
                t = Now + TimeValue("0:00:05")
                    Do
                        DoEvents
                    Loop While t > Now
            End If
        Next i
Set arr = Nothing
End Sub
[/vba]

код выдал ошибку при выполнении макроса (Макрос4())
не найден объект
стоп на строке
[vba]
Код
     Set shp = ActiveSheet.Shapes.AddPicture(Range(Macr), False, True, -1, -1, -1, -1)
[/vba]
перебор у меня отработал корректно

Автор - K-SerJC
Дата добавления - 12.02.2019 в 15:47
ПутинВВ Дата: Пятница, 15.02.2019, 10:17 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Понятно.
Всем большое спасибо за ответы.
 
Ответить
СообщениеПонятно.
Всем большое спасибо за ответы.

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

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