Переименование только определенных листов в макросе - PullRequest
0 голосов
/ 23 ноября 2018

Я пытаюсь найти макрос, который будет переименовывать только определенные листы на основе ячейки, и использовать эту же ячейку в других листах для других целей.Я видел две макро-функции.Тот, который говорит ему начать на определенном n-м листе рабочей книги.Другой говорит, что нужно переименовывать только определенные листы.У обоих вариантов есть проблемы.Что делать, если вы хотите добавить листы?Тогда ваш первый горячий лист не будет таким же, как раньше.Теперь это может быть 11-й лист вместо 5-го.Ваш макрос нужно будет обновить, что противоречит цели всего этого.Что касается второго варианта, просто перечислите все листы, которые вы хотите переименовать: что вы делаете после первого запуска макроса?Имена листов в макросе необходимо будет обновить, чтобы они соответствовали вашим новым именам листов, а также не соответствовали цели всего этого.

Я попытался запустить макрос по имени листа vba, а не по листу.название.И все равно это не сработает.

Sub h100_monthyear()        
    Dim rs As Worksheet
    For Each rs In Sheets  
        If x01st.select <> And x02nd.select <> And x03rd.select <> And x04th.select <> And x05th.select <> And x06th.select <> And x07th.select <> And x08th.select <> And x09th.select <> And x10th.select <> And x11th.select <> And x12th.select <> And x13th.select <> And x14th.select <> And x15th.select <> And x16th.select <> And x17th.select <> And x18th.select <> And x19th.select <> And x20th.select <> And x21st.select <> And x22nd.select <> And x23rd.select <> And x24th.select <> And x25th.select <> And x26th.select <> And x27th.select <> And x28th.select <> And x29th.select <> And x30th.select <> And x31st.select <> Then     
            rs.Name = rs.Range("h100") 
    Next rs
End Sub 

Я не смог получить другие решения из этой темы Переименование листов в макросе без переименования первых четырех листов , и Дэвид на меня наорал(менеджер сайта) за попытку опубликовать там.Пользователи остерегаются, очевидно, вы должны быть осторожны, когда вы публикуете определенные вещи.

Для быстрого ознакомления, вот самый основной макрос, на котором основано выше:

Sub h100_monthyear()
    Dim rs As Worksheet 
    For Each rs In Sheets
        rs.Name = rs.Range("h100")
    Next rs 
End Sub

Я также попробовал этос именами листов VBA следующим образом:

x01st <> And x02nd <> And x03rd <> And x04th <> And x05th <> And x06th <> And x07th <> And x08th <> And x09th <> And x10th <> And x11th <> And x12th <> And x13th <> And x14th <> And x15th <> And x16th <> And x17th <> And x18th <> And x19th <> And x20th <> And x21st <> And x22nd <> And x23rd <> And x24th <> And x25th <> And x26th <> And x27th <> And x28th <> And x29th <> And x30th <> And x31st <> Then

Кто-нибудь может помочь?

1 Ответ

0 голосов
/ 23 ноября 2018

Ваша проблема в том, что этот If x01st.select <> And x02nd.select <> And x03rd.select <> And x04th.select … не является допустимым синтаксисом.

Я предлагаю поместить все имена рабочих листов, которым разрешено переименование, в массив WsNameList и проверить в вашем цикле, еслиимя текущего рабочего листа rs.Name находится в WsNameList.Поэтому я использовал функцию IsInArray.

Sub h100_monthyear()
    Dim WsNameList As Variant
    WsNameList = Array("x01st", "x02nd", "x03rd", "x04th", "x05th") 'add more sheets here

    Dim rs As Worksheet
    For Each rs In Worksheets
        If IsInArray(rs.Name, WsNameList) Then
            rs.Name = rs.Range("h100")
        End If
    Next rs
End Sub

Public Function IsInArray(ByVal FindString As String, ByVal InArray As Variant) As Boolean
    IsInArray = (UBound(Filter(InArray, FindString)) > -1)
End Function

Альтернативно (без списка массивов)

Sub h100_monthyear_ALTERNATIVE()
    Dim rs As Worksheet
    For Each rs In Worksheets
        If rs.Name = "x01st" Or rs.Name = "x02nd" Or rs.Name = "x03rd" Or _
           (rs.Name Like "x??th" And Val(Mid(rs.Name, 2, 2)) >= 4 And Val(Mid(rs.Name, 2, 2)) <= 31) Then
            rs.Name = rs.Range("h100")
        End If
    Next rs
End Sub
...