截断表名称时出错

我正在使用以下命名表单：

arrayCollabName = Array("CBDeltaBlockStatus_SAP03_to_Delta01", "CBDeltaBlockStatus_SAP03_to_Delta02", "CBDeltaDeliveryInformation_SAP03_to_Delta01") If Len(arrayCollabName(idx)) > 31 Then ActiveSheet.Name = Left(arrayCollabName(idx), 31) Else ActiveSheet.Name = arrayCollabName(idx) End If 

在数组中，名称被截断为31个字符时，第一个和第二个名称是相似的，VB会抛出错误“无法将表重命名为与另一个工作表相同的名称，引用的对象库或Visualbasic引用的工作簿”。

任何方式，我可以做到这一点没有错误，并命名为CBDeltaBlock_SAP03_to_Delta01和CBDeltaBlock_SAP03_to_Delta02或任何所需的名称的工作表。

Answer 1

这里是一个例子，如果它已经存在，更改表名。

 Option Explicit Sub Sample() Dim i As Long Dim strShName As String strShName = "BlahBlah" Sheets.Add Do Until DoesSheetExist(strShName) = False i = Int((1000 * Rnd) + 1) strShName = strShName & i Loop ActiveSheet.Name = strShName End Sub Function DoesSheetExist(ByVal strSheetName As String) As Boolean Dim ws As Worksheet On Error Resume Next Set ws = Sheets(strSheetName) On Error GoTo 0 If Not ws Is Nothing Then DoesSheetExist = True End Function 

上面的方法将在工作表的末尾添加一个随机数。 如果你想增加顺序，然后使用下面的代码。

 Option Explicit Sub Sample() Dim i As Long Dim strShName As String strShName = "BlahBlah" Sheets.Add If DoesSheetExist(strShName) = True Then i = 1 Do Until DoesSheetExist(strShName & i) = False i = i + 1 Loop strShName = strShName & i End If ActiveSheet.Name = strShName End Sub Function DoesSheetExist(ByVal strSheetName As String) As Boolean Dim ws As Worksheet On Error Resume Next Set ws = Sheets(strSheetName) On Error GoTo 0 If Not ws Is Nothing Then DoesSheetExist = True End Function 

注意 ：上面的代码只是示例代码。 error handling尚未被纳入上述代码，不用说error handling是必须的:)