EXCUSE ME

請問~~

為什麼下面的程式不能不用把加在sheet1後面的新工作頁刪除

就可以按play繼續產生呢??

Sub test()

a = Application.InputBox(prompt:="請輸入第一數", Title:="a到b之間c的倍數")

b = Application.InputBox(prompt:="請輸入第二數", Title:="a到b之間c的倍數")

c = Application.InputBox(prompt:="請輸入倍數", Title:="a到b之間c的倍數")

sheet_one = "do loop"

Cells(1, 2) = "第一數"

Cells(2, 2) = "第二數"

Cells(3, 2) = "倍數"

Cells(1, 3) = a

Cells(2, 3) = b

Cells(3, 3) = c

If a Mod c <> 0 Then

a = c * ((a \ c) + 1)

End If

locate = 5

For i = a To b Step c

locate = locate + 1

Cells(locate, 5) = "sum of number from"

Cells(locate, 6) = a

Cells(locate, 7) = "to"

Cells(locate, 8) = i

Cells(locate, 9) = "is"

Sum = Sum + i

Cells(locate, 10) = Sum

Next i

'=================================================================

Worksheets.Add(after:=Worksheets(1)).Name = "do loop"

Sum = 0

Cells(1, 2) = "第一數"

Cells(2, 2) = "第二數"

Cells(3, 2) = "倍數"

Cells(1, 3) = a

Cells(2, 3) = b

Cells(3, 3) = c

Application.DisplayAlerts = False

For Each ws In Worksheets

If Right(ws.Name, Len(sheet_one)) = sheet_one Then

existence = ture

Exit For

End If

Next ws

If existence = ture Then

Sheets(sheet_one).Delete

Worksheets.Add(after:=Worksheets(1)).Name = sheet_one

existence = False

Else

Worksheets.Add(after:=Worksheets(1)).Name = sheet_one

existence = flase

End If

a1 = a

Do While a Mod c <> 0

a1 = a1 + 1

Loop

locate = 5

For i = a1 To b Step c

locate = locate + 1

Cells(locate, 5) = "sum of number from"

Cells(locate, 6) = a1

Cells(locate, 7) = "to"

Cells(locate, 8) = i

Cells(locate, 9) = "is"

Sum = Sum + i

Cells(locate, 10) = Sum

Next i

End Sub

2 Answers

Rating
  • 1 decade ago
    Favorite Answer

    看不太懂你的意思,能否說得更明確些?

    2007-06-15 14:38:53 補充:

    每次執行時會檢查工作表 sheet_one 是否存在?

    若 sheet_one 不存在,則在現存工作表的最後加一個新工作表。

    若 sheet_one 已存在,則將該工作表的內容清除。

    Sub doloop()

    Dim a As Integer, b As Integer, c As Integer

    Dim i As Integer, locate As Integer

    Dim sheet_one As String

    Dim existence As Boolean

    Application.DisplayAlerts = False

    sheet_one = "do loop"

    existence = False

    For Each ws In Worksheets

    If Right(ws.Name, Len(sheet_one)) = sheet_one Then

    existence = True

    Exit For

    End If

    Next ws

    If existence Then

    Worksheets(sheet_one).Cells.ClearContents

    Else

    Worksheets.Add(after:=Worksheets(Sheets.Count)).Name = sheet_one

    End If

    Worksheets(sheet_one).Activate

    a = Val(Application.InputBox(prompt:="請輸入第一數", Title:="a到b之間c的倍數"))

    b = Val(Application.InputBox(prompt:="請輸入第二數", Title:="a到b之間c的倍數"))

    c = Val(Application.InputBox(prompt:="請輸入倍數", Title:="a到b之間c的倍數"))

    Sum = 0

    Cells(1, 2) = "第一數"

    Cells(2, 2) = "第二數"

    Cells(3, 2) = "倍數"

    Cells(1, 3) = a

    Cells(2, 3) = b

    Cells(3, 3) = c

    If c = 0 Then Exit Sub

    a1 = a

    Do While a1 Mod c <> 0

    a1 = a1 + 1

    Loop

    locate = 5

    For i = a1 To b Step c

    locate = locate + 1

    Cells(locate, 5) = "sum of number from"

    Cells(locate, 6) = a1

    Cells(locate, 7) = "to"

    Cells(locate, 8) = i

    Cells(locate, 9) = "is"

    Sum = Sum + i

    Cells(locate, 10) = Sum

    Next i

    End Sub

  • For Each ws In Worksheets

    If Right(ws.Name, Len(sheet_one)) = sheet_one Then

    那段應該放在

    Worksheets.Add(after:=Worksheets(1)).Name = "do loop"

    之前吧@"@

    這樣才不會產生命名相同的問題

    不過 看不懂你的問題是? @"@

    2007-06-15 15:24:48 補充:

    東邪無弓 大大說的

    應該就是解答了吧^ ^

Still have questions? Get your answers by asking now.