[發問] 用迴圈判斷sheet名稱是否相同，並複製(已解決~感謝各位)

iceandy6150

我有兩個sheet，一個是<功能>，另一個是<1>
<1>裡面有設定按鈕，能統計裡面的資料，我要當樣本
<功能>裡面我設了一個textbox可以輸入數量，還有按鈕，按了會自動複製該數量的sheet加在<1>後面
               而且名稱自動增加<2>，<3>，<4>，......
可是寫不太出來，求助板上大大

Private Sub CommandButton1_Click()
    Dim E          '這是看別人寫的
    Dim a, b As String
    Dim c As Integer
b = textbox1.text   '抓數量過來，所以把b定義String

For a = 2 To b
      
    For Each E In Sheets
            If   E.Name = a   Then          '判斷目前檔案中所有sheet是否同名
              MsgBox (a + "重覆了")
              c = 1
              Exit For
            Else
              c = 0
             MsgBox (a+"未重覆可新增")
             Exit For
           End If
        Next
   
     If c = 0 Then
     Worksheets(a - 1).Copy after:=Worksheets(a - 1)
     ActiveSheet.Name = a
     End If
Next
End Sub

希望目標是a=2判斷一次，a=3判斷一次.......。一開始只有<1>很好新增
但若把數量從5改8，再按一次，照理說<1><2><3><4><5>會顯示重覆了，只新增<6><7><8>
不過好像跑不出來，迴圈好像也迴了好幾次 @_@"

Hsieh

回復 1# iceandy6150


Private Sub CommandButton1_Click()
If TextBox1 <> "" Then
For i = 1 To Val(TextBox1)
   With Sheets.Add(after:=Sheets(Sheets.Count))
   .Name = CStr(Sheets.Count)
   End With
Next
End If
End Sub

iceandy6150

回復  iceandy6150


Private Sub CommandButton1_Click()
If TextBox1  "" Then
For i = 1 To Val(T ...
Hsieh 發表於 2012-2-16 23:44

大大，你的方法可以新增.....輸入的數量的sheet
可是我要以<1>這個sheet為樣本，所有新增的都是複製<1>
另外是防呆功能
例如第一次輸入5 ----> 程式新增 <2><3><4><5>  (1原本就有)
但後來覺得5個不夠用，於是輸入8--->程式判斷1~5已經有了，不新增。6~8新增
(這樣1~5內的資料不會被動到)

謝謝

Hsieh

回復 3# iceandy6150

1. Private Sub CommandButton1_Click()
   
2. Application.ScreenUpdating = False
   
3. If TextBox1 <> "" Then
   
4. For i = 1 To Val(TextBox1) - Sheets.Count
   
5.    Sheets(1).Copy after:=Sheets(Sheets.Count)
   
6.    ActiveSheet.Name = CStr(Sheets.Count)
   
7. Next
   
8. End If
   
9. Application.ScreenUpdating = True
   
10. End Sub

複製代碼

iceandy6150

回復 4# Hsieh


    哇~太神奇了吧
雖然我看不太懂什麼意思
但是貼上程式後測試
ok耶~~~
太感謝你了~~:loveliness:

我知道的函數太少了，非常弱的新手一個:'(

iceandy6150

回復  iceandy6150
Hsieh 發表於 2012-2-17 00:10

    超級版主不好意思
今天測試發現一些小問題
用sheet.count是可以算出sheet的數目
但是我可能有<功能><命令>等sheet存在
例如我現有的sheet是 <功能><測試><命令><1>
如果textbox輸入4，那麼將不會動作，因為sheet數量有4個了
輸入5，會變成<功能><測試><命令><1><5>

目標是每次核對目前所有sheet的名稱是否有相同的
若有則不新增，若無才新增
而且新增時只新增純數字名稱的sheet
不會把其他非數字名稱的sheet算入

謝謝

GBKEE

回復 6# iceandy6150

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim xSH As Integer, Sh As Worksheet, xi As Integer, A As Integer
   
4.     A = 6
   
5.     For Each Sh In Sheets
   
6.         If IsNumeric(Sh.Name) Then xSH = xSH + 1
   
7.     Next
   
8.     For xi = xSH + 1 To A
   
9.         Sheets("1").Copy , Sheets(Sheets.Count)
   
10.         Sheets(Sheets.Count).Name = xi
    
11.     Next
    
12. End Sub

複製代碼

iceandy6150

回復 7# GBKEE


    大大請問一下
你的程式要怎麼放?
我這樣放好像不能動... (我放在按鈕裡面)
Private Sub CommandButton2_Click()
Option Explicit
Sub Ex()
    Dim xSH As Integer, Sh As Worksheet, xi As Integer, A As Integer
    A = 6
    For Each Sh In Sheets
        If IsNumeric(Sh.Name) Then xSH = xSH + 1
    Next
    For xi = xSH + 1 To A
        Sheets("1").Copy , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = xi
    Next
End Sub
End Sub

iceandy6150

版主大大~~我修改了一下，可以用了耶
好棒阿!!!!
Private Sub CommandButton2_Click()
   
    Dim xSH As Integer, Sh As Worksheet, xi As Integer, A As Integer
    A = Val(TextBox1)
    For Each Sh In Sheets
        If IsNumeric(Sh.Name) Then xSH = xSH + 1
    Next
    For xi = xSH + 1 To A
        Sheets("1").Copy , Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = xi
    Next

End Sub

感謝再感謝~~

hugh0620

樓主~
G大大或H大大都是很厲害的高手~

但站在SA的角度~ 其實還是會有一定的BUG存在
G大大的程式碼~ 當sheet.Name 不是出現的連續號碼~ 會產生錯誤
如 textbox1.text=6 執行後~
再隨便砍掉非sheet.name=6的任何一張sheet~ 再重新執行時~ 就會產生bug

若不考量已有的sheet是需要被保留的~ 建議保留基本的sheet~ 其他1,2,3...sheet 建議刪除後~
再重新跑出來~
例.每一次sheet1跑出的資料,都一樣~ 就可以用此方式
例.第一次跑出sheet1的資料與第二次跑出來的sheet1不一樣時~ 就不能這樣的方式~

樓主~  提供這些建議是因為有時使用者不是自己時~ 會產生不同的可能性~
在設計時~ 能盡量考量的完整~ 及結合一些預防可能發生的因素~
會讓你設計出來的工具能夠真正的被使用~