[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シートをコピーして名前の変更を自動で行いたい。』（ぬぬぬ）
VBAについてはネットで調べながら作成しはじめた初心者になります。
シートをコピーしてシート名を変更する下記内容のコードを作成し、実行する事ができたのですが、変更したいところがあります。
いろいろと調べて改良しようしたのですが、どこをどう直せばよいのかがわからず上手くいかなかったため、投稿させて頂きました。
何卒、宜しくお願い致します。
実行していた内容の説明(下記コードで実行できた内容)
Sheet1にはシート名をA2から下のA3,A4・・・に記載しています。
Sheet2がコピー元となるシートになります。
VBAを実行することでSheet2の後ろに、Sheet1に記載した分だけのシートがコピーされ、記載したシート名に変更する事ができました。
変更したい内容
現状、シート名をA2,A3,A4・・・の行順に記載しているのですが、これをE6,F6,G6・・・の列順に変更したいです。
調べてみたところ、ただ単に列順にしたいのであれば、intRowをColumnsに変えればいいのかな、と思ったのですが、シート名の取得及び、コピーする量の取得をE6から始めたいこともあり、難航しています。
下記コードについて、どの様に変更すれば良いかご教授頂けないでしょうか。
宜しくお願い致します。
Private Sub CommandButton1_Click()
Dim intRow As Integer
Dim flg As Boolean
Dim addWs As Worksheet
Dim chkWs As Worksheet
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'シート名は2行目から入力されるので2で初期化
intRow = 2
'シート名の入力がある限り処理を続けます
Do While ws.Cells(intRow, 1) <> ""
flg = True
'シートの存在チェック
For Each chkWs In Worksheets
If chkWs.Name = ws.Cells(intRow, 1) Then
flg = False
Exit For
End If
Next chkWs
'同じシート名がない場合のみ追加
If flg Then
'最後尾にシートを追加します
ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
Set addWs = ActiveSheet
'追加されたシートに名前を付けます
addWs.Name = ws.Cells(intRow, 1)
End If
intRow = intRow + 1
Loop
ws.Activate
End Sub
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
Dim intColumns As Integer
Dim flg As Boolean
Dim addWs As Worksheet
Dim chkWs As Worksheet
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'シート名は6行目4列目から入力されるので6,4で初期化
intColumns = 5
'シート名の入力がある限り処理を続けます
Do While ws.Cells(6, intColumns) <> ""
flg = True
'シートの存在チェック
For Each chkWs In Worksheets
If chkWs.Name = ws.Cells(6, intColumns) Then
flg = False
Exit For
End If
Next chkWs
'同じシート名がない場合のみ追加
If flg Then
'最後尾にシートを追加します
ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
Set addWs = ActiveSheet
'追加されたシートに名前を付けます
addWs.Name = ws.Cells(6, intColumns)
End If
intColumns = intColumns + 1
Loop
ws.Activate
End Sub
（ぬぬぬ） 2021/01/08(金) 10:58
■１
インデントがついておらず見づらいのでとりあえず整理。
Private Sub CommandButton1_Click()
Dim intRow As Integer
Dim flg As Boolean
Dim addWs As Worksheet
Dim chkWs As Worksheet
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'シート名は2行目から入力されるので2で初期化
intRow = 2
'シート名の入力がある限り処理を続けます
Do While ws.Cells(intRow, 1) <> ""
flg = True
'シートの存在チェック
For Each chkWs In Worksheets
If chkWs.Name = ws.Cells(intRow, 1) Then
flg = False
Exit For
End If
Next chkWs
'同じシート名がない場合のみ追加
If flg Then
'最後尾にシートを追加します
ThisWorkbook.Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
Set addWs = ActiveSheet
'追加されたシートに名前を付けます
addWs.Name = ws.Cells(intRow, 1)
End If
intRow = intRow + 1
Loop
ws.Activate
End Sub
■２
シートの存在チェックですが、その方法でも間違いではないですが、ほかのアプローチもあるので紹介します。
Sub シートの存在判定()
Dim Sh As Worksheet
On Error Resume Next
Set Sh = Worksheets("存在しないシート")
On Error GoTo 0
If Sh Is Nothing Then
MsgBox "「存在しないシート」は存在しません"
Else
MsgBox "「存在しないシート」が発見されました"
End If
End Sub
このように、あらかじめエラーをスキップするようにしておいてから、Worksheet型（オブジェクト型）の変数にセットしてみて、セットに失敗しているなら存在しないと判定することができます。
■３
＞シート名をA2,A3,A4・・・の行順に記載しているのですが、これをE6,F6,G6・・・の列順に変更したい
＞intRowをColumnsに変えればいいのかな
ちょっと違います。
ポイントは「 ws.Cells(intRow, 1).Value」のうち【Cells(行番号,列番号)】のところです。
今だと、行番号のほうが変わっていき、列番号（1=A列）は固定されているので、
行番号（６行目）は固定しておいて、列番号が変わっていくように考えればOKです、
踏まえるとこんな感じにすればよいとおもいます。
Sub さんぷる()
Dim SH As Worksheet
Dim 列 As Long
列 = 5 '(E列～)
Do While Worksheets("Sheet1").Cells(6, 列).Value <> ""
'シート存在判定
Set SH = Nothing
On Error Resume Next
Set SH = Worksheets(Worksheets("Sheet1").Cells(6, 列).Value)
On Error GoTo 0
'存在してないときだけ処理
If SH Is Nothing Then
Sheets("Sheet2").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Worksheets("Sheet1").Cells(6, 列).Value
End If
列 = 列 + 1
Loop
Worksheets("Sheet1").Activate
End Sub
（もこな2） 2021/01/08(金) 11:06
本当にありがとうございました。
（ぬぬぬ） 2021/01/08(金) 11:20
横からすみません。気になってしまったので… >コードについてご質問させて頂く際は～
「質問するから」分かりやすく記載するのではないのです。 プログラムを書くのであれば、「自分のために」インデントはつけたほうがいいです。 以下のサイトなどが分かりやすいかと思います。 https://kkblab.com/make/coding.html
最初からインデントをつけていれば、質問の際にはそのままコピペするだけでOKです。 ここの文法ルールによって、文字サイズが大小したりするかもしれませんが そこは些細な問題かと思います。
以上、横から失礼いたしました。 （ななし） 2021/01/08(金) 13:06
ななしさんが紹介されていた記事にこんなのありました。
＞コメント文を書くコツは、「全ての行に書く」ことと「できるだけ分かりやすい言葉に翻訳する」ことです。
こんなバカなこと言っている人ってそんなに居ないと思いますよ。
必要最低限に抑えるのがいいです。 何が必要最低限かは人、組織にもよるので流動的ではあります。
分かり易いコードは、それ自体がコメントでもある。
（半平太） 2021/01/12(火) 10:08
半平太さん インデントのところのみでコメントのところまで読んでいなかったのですが、本当ですね。 （私も毎行になんてコメント書いたことありません…）
ぬぬぬさん インデントってこういうものだよ、というサンプル画像が一番見やすかったサイトを選んだだけですので そこのみの参照としてください。 （ななし） 2021/01/12(火) 11:07
回答ありがとうございます。
頂いた記事を読んでインデントについて、こういうものなんだなと理解する事ができました。
コードに記載するコメントについては自分の職場の理解度を考慮しつつ、必要最低限を意識しようと思います。
ありがとうございました。
（ぬぬぬ） 2021/01/12(火) 11:20
ちょっと面白い話だったので、追記させてもらいます。
すべての行にコメントをつけろ、と言う説は初めて聞きました。 大学教授がこんなことを言ってもらっては困ります。 読んですぐわかることにはコメントしないのが原則ですよ。 真に重要なことが埋もれてしまいます。 半平太さんのご指摘のとおりかと思いました。
プログラムコードの書き方に関する"リーダブルコード"と言う本があります。 (VBAではなくプログラム一般について書かれた本です。 本屋で立ち読みでもしてみてください。)
まとめによれば、こういう考え方があります。ご参考まで。 ■コメントすべきではないこと ・コードからすぐに抽出できること ・ひどいコード（例えば酷い名前の関数）を補う「補助的なコメント」 コメントではなくコードを修正すべき ■記録すべき自分の考え ・なぜコードが他のやりかたではなくこうしたのかの考え方 ・コードの欠陥（今後改善予定のこと）をTODO:などとして示す。 ・定数に値にまつわる「背景」 ■読み手の立場になって考える ・コードを読んだ人がエッと思うだろう所を予想してコメントしておく ・平均的な読み手が驚くような動作は文書化しておく ・ファイルやクラスには「全体像」のコメントを書く ・読み手が細部に捕らわれないように、コードブロックにコメントを付けて概要をまとめる
ちなみに、その本には、 | 「宿題に出したコードの関数には必ずコメントをつけろ」学生たちにこんなことを | 言う大学教授がいる。そんなことを言われたら、コメントをつけていない裸の関数に | 罪悪感を抱き、関数の名前と引数をそのまま文章形式でコメントに書き直すように | なってしまう。 との記述があり、洋の東西を問わず同じなのかと笑ってしまった。
★ インデントに関しては、付け方はいろいろな考え方があると思います。 https://thom.hateblo.jp/entry/2018/02/26/234247 なんかは結構面白いかと思いました。ご参考まで。
（γ） 2021/01/12(火) 12:32
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.