Блог

У меня есть вопрос, у меня есть на одном базовом листе строки, для каждой строки я создаю новый лист, каждый новый лист имеет в ячейке A3 значение, которое я хотел бы использовать в качестве имени для моего нового активного листа. Здесь начинается проблема, так как в Excel имя листа может содержать только 31 знак, некоторые значения в формате A3 повторяются из-за вырезания только 31 знака. Например, у меня на одном листе в формате A3 есть технологические устройства для бизнеса и банков, а на следующем — технологические устройства для бизнеса и частных лиц. Итак, если я возьму 31 знак, оба листа будут иметь одно и то же имя, и я получу сообщение об ошибке, что имя листа уже занято. В моем цикле я просматриваю 1000 строк и проверяю, что повторяющаяся проблема будет появляться 700 раз, поэтому я подумал о том, чтобы вырезать слева 28 чисел вместо 31 и добавить к номеру имени, чтобы иметь уникальное имя для каждого листа. Часть кода (только часть изменения имени):

 Dim name As String
Dim i As Integer
Dim number_repeated As Integer
Dim name_signs As Integer

name = ActiveSheet.Range("a3")
name = Left(name, 31)
For i = 1 To Worksheets.Count
If name <> Worksheets(i).Name Then
ActiveSheet.Name = name
Else
name_signs = ActiveSheet.Range("a3")
name_signs = Left(name_signs, 28)
name_signs = name_signs   CStr(number_repeated)
ActiveSheet.Name = name_signs
number_repeated = 1
number_repeated = number_repeated   1
End If
Next i
  

Если я не читаю слишком быстро, вы допускаете логическую ошибку: один лист назван по-другому, значит, ни один лист не назван таким образом. Вы можете использовать:

 Public Function SheetIsMissing(s$, Optional WB As Workbook) As Boolean
    If WB Is Nothing Then Set WB = ActiveWorkbook
    SheetIsMissing = True
    On Error GoTo theend
    Dim x
    x = WB.Sheets(s).Cells(1, 1)
    SheetIsMissing = False
theend:
End Function
  

опубликованный вами код содержит несколько ошибок:

1) nazwa не был объявлен. рекомендуется: писать Option Explicit в начале страницы макроса (это покажет сообщение, если переменная не была объявлена).

2) код:

 For i = 1 To Worksheets.Count
If name <> Worksheets(i).Name Then
ActiveSheet.Name = name
  

попытается изменить каждый лист на одно и то же имя.

3) number_repeated никогда не будет превышать значение 2, потому что перед каждым его увеличением вы возвращаете его к 1.

может быть, это подойдет:

 Sub Macro1()
For i = 1 To Worksheets.Count
    Worksheets(i).name = Left(Worksheets(i).Range("a3").Value, 28) amp; " " amp; i
Next i
End Sub
  

(Примечание: Чтобы ответить на комментарий и избежать уродливого кода в комментариях)

Следующая функция может получить инициалы заданной строки, присутствующей в ячейке, разделенной разделителем (который является необязательным и имеет символ пробела в качестве значения по умолчанию), а затем присоединяет к нему текущую строку ячейки.

 Option Explicit

Function getInitials(sht_name As Range, Optional delimiter As String = " ")

    Dim sht_desc As String: sht_desc = sht_name.Value
    Dim str_array As Variant
    Dim split_str As Variant
    getInitials = ""

    str_array = Split(sht_desc, delimiter)
    For Each split_str In str_array
      getInitials = getInitials amp; Left(split_str, 1)
    Next

    getInitials = getInitials amp; "_" amp; sht_name.Row

End Function
  

Пример использования:

В ячейке A3 записывается Monthly Report Of Something Really Important , а в B3 записывается =getInitials(A3) , что возвращает MROSRI_3

Я бы выбрал сокращения

итак, вот функция, которая возвращает сокращение строки на основе пробелов (» «) в качестве разделителя слов:

 Function GetInitials(strng As String) As String
    Dim words As Variant, word As Variant
    words = Split(strng, " ")
    For Each word In words
        GetInitials = GetInitials amp; Left(word, 1)
    Next word
End Function
  

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

 Option Explicit

Sub main()
    Dim sht As Worksheet
    Dim shtAcronym As String

    For Each sht In Worksheets
        shtAcronym = GetInitials(sht.Range("A3")) '<- get the acronym out of the current worksheet "A3" cell

        '...
    Next sht
End Sub