重命名工作表基于INPUT BOX

Question

请帮我改变下面的代码。需要通过InputBox

由于选择重命名小区

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 

Answer 1

有可以使用InputBox几种方式接入小区C4。

一种是通过在InputBox选择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 

---

另一个，是通过在InputBox选择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 

---

要了解更多有关InputBox功能：您要使用`InputBox`什么https://msdn.microsoft.com/en-us/library/office/ff839468.aspx