[發問] 從儲存格中資料，新建或找到一個工作表

pitera88

我想要建立一個名單的工作表，裏面是名單的表列

請問如何可以按名單(像超連結)就可以新建一個空白的工作表(有舊的格式空白工作表了)，如果工作表名稱已存在，就開啟那個工作表。

例如：工作表(名單)--內有：張三，李四，王五
        工作表(空白工作表)
點擊「張三」儲存格，就可以複製「空白工作表」名稱是「張三」，如果「張三」工作表已存在則開啟「張三」工作表


以上，麻煩各位大大們了~~
----------------
以前有用過「按鈕」方式新建工作表

Private Sub CommandButton1_Click()
Dim I As String
  
    I = InputBox("請輸入客戶姓名.", "Copy Sheet")
    If I <> "" Then
        Sheets(1).Copy After:=Sheets(Sheets.Count) '複製第一個工作表並放到最後一個
        Sheets(Sheets.Count).Name = I              '最後一個工作表的名稱=I
    Else
        MsgBox "複製失敗(資料表未輸入名稱)"
    End If
End Sub

希望要更方便些~~~ 感恩~~~~~

kimbal

回復 1# pitera88

這個是選上任何一個格子時會發生,有需要可以加上指定範圍

1. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   
2.     On Error GoTo skip
   
3.     Dim I As String
   
4.     I = Target.Cells(1, 1).Value
   
5.     If I <> "" Then
   
6.         Sheets.Add
   
7.         ActiveSheet.Name = I
   
8.     End If
   
9. 
   
10. skip:
    
11. End Sub

複製代碼

緊記代碼要放在工作表裡
  

下載 (57.35 KB)

2013-6-11 13:40

pitera88

回復  pitera88

這個是選上任何一個格子時會發生,有需要可以加上指定範圍緊記代碼要放在工作表裡
kimbal 發表於 2013-6-11 13:41

    謝謝大大的提供方法，
不過請問可以：1新生成的工作表是放在最後。
　　　　　　　２已經有的工作表就開啟工作表，不然會新增的是一個「ＳＨＥＥＴ４」

煩請大大了，感恩！！

stillfish00

回復 3# pitera88

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Cells(1, 1).Value = "" Then Exit Sub
   
3.    
   
4.     On Error GoTo ADD_SH
   
5.     Sheets(Target.Cells(1, 1).Value).Select
   
6.     On Error GoTo 0
   
7.    
   
8.     Exit Sub
   
9.    
   
10. 'Error handle
    
11. ADD_SH:
    
12.     With Sheets.Add(After:=Sheets(Sheets.Count))
    
13.         .Name = Target.Cells(1, 1).Value
    
14.     End With
    
15.     Resume Next
    
16. End Sub

複製代碼

pitera88

回復  pitera88
stillfish00 發表於 2013-6-13 10:20

    stillfish00 大大，我把程式碼貼上去，可是都沒有動作耶~~

有大大可以試看看嗎?? 感恩!!!!!!

pitera88

回復 5# pitera88


    還是有大大可以告訴我，
1．判斷這個名字的工作表，是否已存在?  這個命今要怎麼寫??

2．開啟指定工作表的命令是不是 「Worksheets("名字").Activate」??


感恩!!!!!

Hsieh

回復 6# pitera88

下載 (65.6 KB)

2013-6-14 15:08

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Count > 1 Or Target.Column <> 1 Then Exit Sub
   
3. Application.EnableEvents = False
   
4. If Target <> "" Then
   
5.    On Error GoTo addsheet
   
6.    Sheets(CStr(Target)).Select: GoTo 10
   
7.    
   
8. addsheet:
   
9. MsgBox Target & "工作表不存在"
   
10.    With Sheets.Add(after:=Sheets(Sheets.Count))
    
11.    .Name = CStr(Target)
    
12.    End With
    
13. End If
    
14. 10
    
15. Application.EnableEvents = True
    
16. End Sub

複製代碼

stillfish00

回復 5# pitera88
Sorry，Resume Next 前面漏掉Err.Clear

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Application.EnableEvents = False
   
3. 
   
4.     If Target.Cells(1, 1).Value = "" Then Exit Sub   
   
5.     On Error GoTo ADD_SH
   
6.     Sheets(Target.Cells(1, 1).Value).Select
   
7.     On Error GoTo 0
   
8. 
   
9.     Application.EnableEvents = True   
   
10.     Exit Sub
    
11.    
    
12. 'Error handle
    
13. ADD_SH:
    
14.     With Sheets.Add(After:=Sheets(Sheets.Count))
    
15.         .Name = Target.Cells(1, 1).Value
    
16.     End With
    
17.     Err.Clear
    
18.     Resume Next
    
19. End Sub

複製代碼

。