Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11387 / 13646 ツリー ←次へ | 前へ→

【16390】sheetのコピーについて ririri 04/7/26(月) 22:24 質問[未読]
【16391】Re:sheetのコピーについて Asaki 04/7/26(月) 22:59 回答[未読]
【16392】Re:sheetのコピーについて IROC 04/7/26(月) 23:06 回答[未読]
【16395】Re:sheetのコピーについて ririri 04/7/26(月) 23:17 発言[未読]
【16398】Re:sheetのコピーについて IROC 04/7/26(月) 23:23 回答[未読]
【16393】Re:sheetのコピーについて ririri 04/7/26(月) 23:08 発言[未読]
【16397】Re:sheetのコピーについて Asaki 04/7/26(月) 23:19 回答[未読]
【16400】Re:sheetのコピーについて Asaki 04/7/26(月) 23:41 回答[未読]

【16390】sheetのコピーについて
質問  ririri  - 04/7/26(月) 22:24 -

引用なし
パスワード
   こんばんは。
初心者で考えたのですがわかりません。
ご指導お願い致します。

あるaのシートをコピーして そのコピーしたシートの名前をinputboxにて
シートの名前を取得します。
その名前がすでにある名前の場合に メッセージにて
違う名前にするよう促したいのですが
どのようにすればよいでしょうか?

教えて下さい
お願い致します。

【16391】Re:sheetのコピーについて
回答  Asaki  - 04/7/26(月) 22:59 -

引用なし
パスワード
   こんばんは。

過去ログですが。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=6572;id=excel

シート追加の場合ですから、これをコピーに変えて、
重複したときにInputBox() を再度表示するよう、変更してみては如何でしょうか?

【16392】Re:sheetのコピーについて
回答  IROC  - 04/7/26(月) 23:06 -

引用なし
パスワード
   暇だったので、作ってみました。


Sub shtcopy()
Dim shtName As String
Dim i As Long

  MsgBox "現在のシートをコピーします"
  
ReName:
  shtName = Application.InputBox("シート名を入力して下さい。", "シート名入力", Type:=2)

  If shtName = "False" Then
    MsgBox "キャンセルしました。"
    Exit Sub
  End If

  For i = 1 To Worksheets.Count
    If Worksheets(i).Name = shtName Then
      MsgBox shtName & " は、既にあります。", vbExclamation, "エラー"
      GoTo ReName
    End If
  Next i


  On Error GoTo WrongName
    ActiveSheet.Copy before:=Worksheets(1)
    ActiveSheet.Name = shtName
  On Error GoTo 0
  
  MsgBox "完了"
  Exit Sub

WrongName:
  MsgBox "シート名に使えない文字が含まれています。", vbExclamation, "エラー"
  shtName = Application.InputBox("シート名を入力して下さい。", "シート名入力", Type:=2)
Resume 0
End Sub

【16393】Re:sheetのコピーについて
発言  ririri  - 04/7/26(月) 23:08 -

引用なし
パスワード
   ▼Asaki さん:
>こんばんは。
>
>過去ログですが。
>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=6572;id=excel
>
>シート追加の場合ですから、これをコピーに変えて、
>重複したときにInputBox() を再度表示するよう、変更してみては如何でしょうか?


お返事大変有難うございます。
過去ログ見てみたのですが

なにやら 自分で作成する自身がありません。
どこを どう変更したらよいのでしょうか?
ご指導願えますでしょうか?

【16395】Re:sheetのコピーについて
発言  ririri  - 04/7/26(月) 23:17 -

引用なし
パスワード
   iroc様

暇だから作ったなんて・・・
すごいです!!
私なんて まだまだ勉強中なので
暇でもこんな すごいの作成できません

なんとなーーくは 理解できるのですが
解読の説明頂いて良いですか?厚かましくてすいません。
勉強のため知りたいです。特に
最後の go to のくだりのあたりとか・・

お願い致します。

お返事ありがとうございました。

【16397】Re:sheetのコピーについて
回答  Asaki  - 04/7/26(月) 23:19 -

引用なし
パスワード
   >なにやら 自分で作成する自身がありません。
>どこを どう変更したらよいのでしょうか?
過去ログのコードについては、各行が何をしているのか、お分かりですか?
そうでなければ、ヘルプを調べてみてください。

【16398】Re:sheetのコピーについて
回答  IROC  - 04/7/26(月) 23:23 -

引用なし
パスワード
   >ReName:

>   MsgBox shtName & " は、既にあります。", vbExclamation, "エラー"
>   GoTo ReName

シート名は重複するので、再入力させる為に
goto文で ReName: にジャンプします。
: の付いているものをラベルといいます。
gotoはラベルにジャンプする構文です。


>  On Error GoTo WrongName
この文以降で、エラーが発生した場合は、WrongName: にジャンプします。

    ActiveSheet.Copy before:=Worksheets(1)

以下のシート名変更において、/ などの使えない文字に
シート名が変更されるとエラーが発生するので、
発生したときは、WrongName: にジャンプします。
    ActiveSheet.Name = shtName

>  On Error GoTo 0
これは、On Error GoTo WrongName の解除です。
  
  MsgBox "完了"
>  Exit Sub
マクロ終了です


>WrongName:
>  MsgBox "シート名に使えない文字が含まれています。", vbExclamation, "エラー"
>  shtName = Application.InputBox("シート名を入力して下さい。", "シート名入力", Type:=2)

>Resume 0
これは、エラーの発生した行にジャンプします。

>End Sub

【16400】Re:sheetのコピーについて
回答  Asaki  - 04/7/26(月) 23:41 -

引用なし
パスワード
   とりあえず、一案。

Sub test()
  Dim var     As Variant
  Dim sh     As Worksheet

On Error Resume Next
  'シートコピー
  Worksheets("Sheet1").Copy After:=Worksheets(Worksheets.Count)
  Do
    var = Application.InputBox(Prompt:="シート名を入力してください")
    'キャンセル時はコピーしたシートを削除して処理終了
    If VarType(var) = vbBoolean Then
      Application.DisplayAlerts = False
      ActiveSheet.Delete
      Application.DisplayAlerts = True
      Exit Do
    End If

    Set sh = Worksheets(var)
    If sh Is Nothing Then
      ActiveSheet.Name = var
      Set sh = Worksheets(var)
      If sh Is Nothing Then MsgBox "不正なシート名です"
    Else
      MsgBox "既に同名のシートが存在しています"
      Set sh = Nothing
    End If
  Loop While (sh Is Nothing)
On Error GoTo 0
  Set sh = Nothing

End Sub

内容については、ヘルプで御確認ください。

11387 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free