Question

基本上我创建了一个跟踪表，其上有一个单元格，单击该单元格后，将在同一工作簿中创建一个新的Excel工作表。出于测试目的，我目前正在创建一个新的工作表，但最终我还有一张它要复制的工作表。我需要帮助的是，如何让VB拉出一个单元格值作为新/复制表单的名称？这是场景：

每行都有一个客户端列（即C列），我想将其用于将要创建的工作簿的名称。我试图让一个单元格（比如该行中的R列）在单击时创建一个新工作表并将该行中C列的值作为工作表的名称。

所以，说第5行有＃34;测试客户端＆＃34;在C5。单击R5时，我希望它创建一个名为＆＃34; Test Client＆＃34;的工作表。我已经看过使用循环遍历列的解决方案，并为每个列创建一个表单，但这对我的场景不起作用，因为我需要它们在运行中创建而不是总是为每一行。

我知道如何在vb中创建工作表，但我的问题是获得名称。有没有办法让vba从列C中为其激活的行中提取名称？因此，如果它被激活为第5行，它会拉动C5，如果它是第10行，它会拉动C10等。

我们将非常感谢任何建议，我目前正在使用它来创建表格：

Sub CreateSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
End Sub

并致电：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then Call CreateSheet

End Sub

Answer 1

下面的代码读取C列中相关行的值，然后将其作为String传递给您的函数：

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then
    Dim ShtName         As String

    ShtName = Cells(Target.Row, "C").Value
    Call CreateSheet(ShtName)
End If

End Sub

这是你的功能，我添加了一个代表工作表名称的String：

Public Sub CreateSheet(ws_Name As String)

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

ws.Name = ws_Name

End Sub

Answer 2

更新：正如Shai Rado指出我错过了一个错误处理程序。

您应该先测试工作表是否存在。此模式将使您更容易调试并为代码添加功能。

工作表模块

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ws As Worksheet
    Dim WorksheetName As String

    If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then

        WorksheetName = Cells(Target.Row, "C").Value

        Set ws = getWorkSheet(WorksheetName)

        If Not ws Is Nothing Then Set ws = getNewWorkSheet(WorksheetName)           

    End If

End Sub

标准模块

Function getWorkSheet(WorksheetName As String, Optional WorkbookName As String) As Worksheet
    If Len(WorkbookName) = 0 Then WorkbookName = ThisWorkbook.Name

    With Workbooks(WorkbookName)
        On Error Resume Next
        Set getWorkSheet = .Worksheets(WorksheetName)
        On Error GoTo 0
    End With

End Function

Function getNewWorkSheet(WorksheetName As String, Optional WorkbookName As String) As Worksheet
    Dim ws As Worksheet

    If Len(WorkbookName) = 0 Then WorkbookName = ThisWorkbook.Name

    With Workbooks(WorkbookName)
        Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        On Error Resume Next
        ws.Name = WorksheetName

        If Err.Number = 0 Then
            Set getNewWorkSheet = ws
        Else
            ws.Delete
        End If
        On Error GoTo 0

    End With
End Function

如何在根据特定列但可变行中的单元格的值命名工作表时创建/复制工作表？

2 个答案:

工作表模块

标准模块