重命名工作表基于INPUT BOX

请帮我改变下面的代码。 需要通过InputBoxselect重命名单元格

谢谢

 Sub RenWSs() Dim WS As Worksheet Dim shtName Dim newName As String Dim i As Integer For Each WS In Worksheets With WS If Trim(.Range("c14")) <> "" Then shtName = Split(Trim(.Range("c14")), " ") newName = shtName(0) On Error GoTo ws_name_error .Name = newName GoTo done repeat: .Name = newName & i GoTo done ws_name_error: i = i + 1 Resume repeat End If End With On Error GoTo 0 done: Next End Sub 

有几种方法可以使用InputBox来访问单元格C4。

一个是通过在InputBoxselect一个String ,看下面的代码:

 Dim RngStr As String RngStr = Application.InputBox(prompt:="Select the Cell for the new Sheet's name", Type:=2) If Trim(.Range(RngStr)) <> "" Then 

另一种方法是通过在InputBoxselect一个Range ,参见下面的代码:

 Dim rng As Range Set rng = Application.InputBox(prompt:="Select the Cell for the new Sheet's name", Type:=8) If Trim(rng) <> "" Then 

完整的代码

 Option Explicit Sub RenWSs() Dim WS As Worksheet Dim shtName Dim newName As String Dim i As Integer Dim RngStr As String RngStr = Application.InputBox(prompt:="Select the Range for the new Sheet's name", Type:=2) For Each WS In Worksheets With WS If Trim(.Range(RngStr)) <> "" Then shtName = Split(Trim(.Range(RngStr)), " ") newName = shtName(0) On Error GoTo ws_name_error .Name = newName GoTo done repeat: .Name = newName & i GoTo done ws_name_error: i = i + 1 Resume repeat End If End With On Error GoTo 0 done: Next End Sub 

要了解有关InputBoxfunction的更多信息,请访问: https : //msdn.microsoft.com/en-us/library/office/ff839468.aspx