Question

我有一个问题，我在一个基本工作表，行，每行创建新工作表，每个新工作表都有单元格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

Answer 1

除非我读得太快，否则你会犯一个逻辑错误：一张表的名称不同意味着不会以这种方式命名工作表。你可以使用：

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

您发布的代码包含的错误很少：

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) & " " & i
Next i
End Sub

Answer 3

（注意：回答评论并避免评论中出现丑陋的代码）

以下函数可以获取单元格中存在的给定字符串的首字母，由分隔符分隔（可选，并且空格字符为默认值），然后将当前单元格行连接到它。

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

您可以按如下方式使用：

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

活动表VBA EXCEL的唯一性

4 个答案: