アクティブシートの一意性VBAエクセル

Question

私は質問があります、私は1つの基本的なシートに行を持っています、私は新しいシートを作成し、それぞれの新しいシートは私が名前として使用したいセルA3の値を持っています私の新しいアクティブシート。ここで問題は始まります。シートの名前は31の符号のみを持つことができますが、A3の値の一部は31の符号のみをカットしているため繰り返されます。例えば、私はビジネスと銀行向けのA3テクノロジーアプライアンスとして、そしてビジネスとプライベートのための次の1つのテクノロジーアプライアンスとして1枚のシートを持っています。だから私が31の看板を取ると、両方のシートが同じ名前になり、シートの名前が既に取られているというエラーが出る。私のループでは1000行を繰り返し、繰り返しの問題が700回現れることを確認したので、31の代わりに左の28の数字から切り捨てて、各シートに固有の名前を付けるために名前番号を追加することを考えました。コード（名前を変更するだけの部分）の一部：

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 

Answer 1

私はあまりにも速く読んでいない限り、あなたは論理的なエラーを作る：1シートがある別の名前ではありません何のシートがこのよう命名されていないことを意味します。 あなたが使用することができます：

1）nazwaが宣言されませんでした：あなたが投稿した

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 

Answer 2

コードはいくつかのエラーが含まれています。推奨：マクロページの先頭にOption Explicitを書きます（変数が宣言されていない場合はメッセージが表示されます）。

2）コード：

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

は、同じ名前にすべてのシートを変更しようとします。

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

Answer 3

（注：するために、すべての時間はあなたがそれを増やす前に、あなたは多分これが行います。1.

に戻ってそれを設定しているため

3）number_repeatedは、2値を超えることはありませんコメントに答えるとコメントに醜いコードを避けてください）

次の関数は、セルにある指定された文字列の頭文字を区切り文字で区切って取得できます（オプションで、スペース文字erをデフォルト値として）、現在のセル行を連結します。

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 & Left(split_str, 1) 
    Next 

    getInitials = getInitials & "_" & sht_name.Row 

End Function 

使い方の例：セルA3で

がMonthly Report Of Something Really Important書き込まれ、B3に=getInitials(A3)書かれている、MROSRI_3

Answer 4

を返す私はそうここ頭文字

で行くと思いますスペース（ ""）に基づいて文字列の頭字語を単語セパレータとして返す関数：

次のように使用することができます

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

：

イニシャルの、A列に実際のページ名を持つ隠されたシートを持っており、コードで列Bの、のは言わせないのはなぜ

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