Перебор названий листов в цикле

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Перебор названий листов в цикле (Макросы/Sub)

drugojandrew

Дата: Воскресенье, 05.04.2020, 13:53 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 141

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

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

Excel 2013

Добрый день!
Подскажите, пожалуйста, как в этом макросе:
[vba]

Код

Sub DataCopy()
  Dim n As Long, rngData As Range
  Set rngData = Sheets("Data").Range("A1:A15")
  rngData.Copy
    For n = 1 To ThisWorkbook.Worksheets.Count
        If ThisWorkbook.Worksheets(n).Name = "1_Yes" Or ThisWorkbook.Worksheets(n).Name = "3_Yes" _
           Or ThisWorkbook.Worksheets(n).Name = "4_Yes" Or ThisWorkbook.Worksheets(n).Name = "5_Yes" _
           Or ThisWorkbook.Worksheets(n).Name = "7_Yes" Then
            With Sheets(n)
                .Cells(1, 1).PasteSpecial Paste:=xlValues
            End With
        End If
    Next n
End Sub

[/vba]
упростить эту запись:
[vba]

Код

If ThisWorkbook.Worksheets(n).Name = "1_Yes" Or ThisWorkbook.Worksheets(n).Name = "3_Yes" _
Or ThisWorkbook.Worksheets(n).Name = "4_Yes" Or ThisWorkbook.Worksheets(n).Name = "5_Yes" _
Or ThisWorkbook.Worksheets(n).Name = "7_Yes" Then

[/vba]
т.е. вместо того, чтобы перечислять листы через Or, задать переменную листам.

Ответить

nilem

Дата: Воскресенье, 05.04.2020, 14:13 | Сообщение № 2

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

drugojandrew, привет
например, такой вариант:
[vba]

Код

Sub DataCopy()
Dim n As Long, sNm As String
sNm = "~1_Yes~3_Yes~4_Yes~5_Yes~7_Yes~"
With ThisWorkbook
    .Sheets("Data").Range("A1:A15").Copy
    For n = 1 To .Sheets.Count
        If InStr(sNm, .Sheets(n).Name) Then Sheets(n).Cells(1, 1).PasteSpecial Paste:=xlValues
    Next n
End With
Application.CutCopyMode = False
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Воскресенье, 05.04.2020, 14:15

Ответить

drugojandrew

Дата: Воскресенье, 05.04.2020, 17:19 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 141

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

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

Excel 2013

nilem, спасибо, то, что надо.

Ответить

Gustav

Дата: Воскресенье, 05.04.2020, 22:04 | Сообщение № 4

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

Ранг: Участник клуба

Сообщений: 2797

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

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Цитата nilem, 05.04.2020 в 14:13, в сообщении № 2 ()

например, такой вариант:

Или такой:
[vba]

Код

Sub DataCopy()
    Dim strName As Variant 'String не подходит
    With ThisWorkbook
        .Sheets("Data").Range("A1:A15").Copy
        For Each strName In Array("1_Yes", "3_Yes", "4_Yes", "5_Yes", "7_Yes")
            Sheets(strName).Cells(1, 1).PasteSpecial Paste:=xlValues
        Next strName
    End With
    Application.CutCopyMode = False
End Sub

[/vba]

[p.s.]А конкретно эту задачу можно даже без цикла - мультишитовой вставкой, т.е. с предварительным выделением всех нужных листов и затем собственно вставкой в один из них - эффект вставки распространится на все выделенные:[/p.s.]
[vba]

Код

Sub DataCopy()
    With ThisWorkbook
        .Sheets("Data").Range("A1:A15").Copy
        .Sheets(Array("1_Yes", "3_Yes", "4_Yes", "5_Yes", "7_Yes")).Select
        .Sheets("1_Yes").Cells(1, 1).PasteSpecial Paste:=xlValues
    End With
    Application.CutCopyMode = False
End Sub

[/vba]

МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Воскресенье, 05.04.2020, 22:27

Ответить

Перебор названий листов в цикле (Макросы/Sub)

Страница 1 из 1
1