[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『 (2) 後から見てコードのわかりやすい書き方』(see)
【Mainシート】 Mainシートにコマンドボタンを計算方法(オプションボタン)と結果出力(チェックボックス)を置いています ○計算方法1 ○計算方法2 ○計算方法3 オプションボタン リンクするセルRange("O4") □結果出力 チェックボックス リンクするセルRange("O6")
【作業内容を日本語で書きだしてみる】 (前回作業のシートが残っていれば、メッセージを出してexit) 「計算方法」が 1であれば、計算用A・結果A・計算用B・結果Bのどれかのシートがあればメッセージを出してexit 「計算方法」が 2であれば、計算用Aまたは結果Aのシートがあればメッセージを出してexit 「計算方法」が 3であれば、計算用Bまたは結果Bのシートがあればメッセージを出してexit
(シートの作成) 「計算方法」が 1であれば、計算用A 計算用Bのシートを作成 「計算方法」が 1で「結果」がTRUEであれば、結果Aと結果Bのシートを作成
「計算方法」が 2であれば、計算用Aのシートを作成 「計算方法」が 2で「結果」がTRUEであれば、結果Aのシートを作成
「計算方法」が 3であれば、計算用Bのシートを作成 「計算方法」が 3で「結果」がTRUEであれば、結果Bのシートを作成
【実際にコードを書いてみる】 Private Sub CommandButton1_Click()
Dim ErrMsg As String
Dim 計算方法 As Integer Dim 結果出力 As Boolean
Dim i As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
' On Error GoTo Err1
計算方法 = ws.Range("O4") '1=A・B 2=A 3=B 結果出力 = ws.Range("O6") 'True=出力 False=出力しない
'前回作業シートチェック Select Case 計算方法
Case 1 wSheet = Array("計算用A", "計算用B", "結果A", "結果B")
Case 2 wSheet = Array("計算用A", "結果A")
Case 3 wSheet = Array("計算用B", "結果B")
End Select
For i = 0 To UBound(wSheet) ErrMsg = "Sheetが残っています。" & vbCr & vbCr & vbCr & wSheet(i) If ExistsWorksheet(wSheet(i)) = True Then GoTo Err1 Next
'シート作成 ErrMsg = "シート作成中のエラーです。" Select Case 計算方法
Case 1 If 結果出力 = True Then wSheet = Array("計算用A", "計算用B", "結果A", "結果B") Else wSheet = Array("計算用A", "計算用B") End If
Case 2 If 結果出力 = True Then wSheet = Array("計算用A", "結果A") Else wSheet = Array("計算用A") End If
Case 3 If 結果出力 = True Then wSheet = Array("計算用B", "結果B") Else wSheet = Array("計算用B") End If End Select
For i = 0 To UBound(wSheet) 新しいシートを作る wSheet(i), Right(wSheet(i), 1) Next
ws.Select
Exit Sub
Err1:
If Err.Description <> "" Then ErrMsg = ErrMsg & vbCr & vbCr & vbCr & "エラーの説明 : " & Err.Description End If MsgBox ErrMsg, vbOKOnly + vbCritical
End Sub
'シートの存在確認 Function ExistsWorksheet(ByVal name As String) As Boolean
Dim ws As Worksheet
For Each ws In Sheets If ws.name = name Then ExistsWorksheet = True Exit Function End If Next
ExistsWorksheet = False
End Function
Function 新しいシートを作る(sName As Variant, title As String) As Worksheet
Dim ws As Worksheet Set ws = Worksheets.Add
With ws .name = sName .Tab.Color = 16764159 .Range("A1") = title End With
Set 新しいシートを作る = ws
End Function
変数になるものを先に書き出して、繰り返しの作業をループで繰り返すようにしてみました
いろんなことが気になって、対応しようとしてズレしまっていそうで不安ではあります
書き方に正解というものがないとは思いますが、 よい書き方があれば教えて頂けると助かります
(前回作業のシートが残っていれば、メッセージを出してexit)のところで、 シートをひとつずつ確認しているので、 メッセージが出てシート削除して、再度実行したらまたメッセージが出るのは どうなのかな…と思っており、今後改善したいなと思っています
< 使用 Excel:Excel2010、使用 OS:Windows10 >
シート削除を入れてあります。
また、通知の場合のコードはコメントアウトしています。
Private Sub CommandButton1_Click() Dim ws As Worksheet Set ws = ActiveSheet Dim wb As Workbook Set wb = ws.Parent
Dim 計算方法 As Integer Dim 結果出力 As Boolean 計算方法 = ws.Range("O4") '1=A・B 2=A 3=B 結果出力 = ws.Range("O6") 'True=出力 False=出力しない '前回作業シートチェック Dim wsNames As Variant Select Case 計算方法 Case 1: wsNames = Array("計算用A", "計算用B", "結果A", "結果B") Case 2: wsNames = Array("計算用A", "結果A") Case 3: wsNames = Array("計算用B", "結果B") End Select
'シートの存在確認 On Error GoTo Err1 Dim wsName As Variant For Each wsName In wsNames If ExistsWorksheet(wb, wsName) Then ' Err.Raise Number:=999, Description:="Sheetが残っています。" & vbCr & vbCr & vbCr & wsName If MsgBox("残っている" & wsName & "シートを削除しますか?", vbQuestion + vbYesNo) = vbYes Then wb.Worksheets(wsName).Delete End If End If Next On Error GoTo 0
'シート作成 For Each wsName In wsNames Dim isAdd As Boolean Select Case 結果出力 Case True: isAdd = True Case Else: If wsName Like "計算用?" Then isAdd = True End Select If isAdd Then AddWorksheet wb, wsName Next
ws.Select ' Exit Sub 'Err1: ' MsgBox Err.Description, vbCritical End Sub Private Function ExistsWorksheet(ByVal wb As Workbook, ByVal wsName As String) As Boolean Dim ws As Worksheet For Each ws In wb.Worksheets If ws.name = wsName Then ExistsWorksheet = True Exit Function End If Next End Function Private Function AddWorksheet(ByVal wb As Workbook, ByVal wsName As Variant) As Worksheet Dim ws As Worksheet Set ws = wb.Worksheets.Add() With ws .name = wsName .Tab.Color = 16764159 .Range("A1").Value = Right(wsName, 1) End With Set AddWorksheet = ws End Function
(tkit) 2023/01/19(木) 11:01:23
おっと 'シート作成 For Each wsName In wsNames Dim isAdd As Boolean isAdd = False '←追加してください (tkit) 2023/01/19(木) 11:21:00
ここもか。
If MsgBox("残っている" & wsName & "シートを削除しますか?", vbQuestion + vbYesNo) = vbYes Then wb.Worksheets(wsName).Delete Else '←追加してください Exit Sub '←追加してください End If (tkit) 2023/01/19(木) 11:27:02
自分が書くならたぶんこうかなぁ・・・ Private Sub CommandButton1_Click() Dim ErrMsg As String Dim 計算方法 As Integer Dim 結果出力 As Boolean
Dim strSheets As String 'シート名の一覧(配列書き出し)用 Dim flgMKWS As Boolean 'シートの作成有無判定用 Dim v As Variant 'For Each用
Dim ws As Worksheet Set ws = ActiveSheet On Error Resume Next '★変数の型を指定しているので、セルの値が型と異なる場合エラーになるのでチェックしておく 計算方法 = ws.Range("O4").Value '1=A・B 2=A 3=B 結果出力 = ws.Range("O6").Value 'True=出力 False=出力しない If Err.Number > 0 Then MsgBox "設定の取得に失敗しました。" & vbCrLf _ & "O4は数値、O6はTrue/Falseで設定してください" Exit Sub End If On Error GoTo 0
'計算方法からシートのチェック '★好みだけど、Arrayより文字列のほうが見やすい・・・ Select Case 計算方法 Case 1: strSheets = "計算用A,計算用B,結果A,結果B" Case 2: strSheets = "計算用A,結果A" Case 3: strSheets = "計算用B,結果B" Case Else MsgBox "計算方法の指定が範囲から外れています。1〜3の値を入力してください。" Exit Sub End Select
'シートの有無チェック ErrMsg = "" '★Splitでカンマで区切って配列として吐き出す For Each v In Split(strSheets, ",") '★ISREF(計算用!A1)の計算式で、シートの有無をチェック If Evaluate("ISREF('" & v & "'!A1)") Then ErrMsg = ErrMsg & v & vbCrLf End If Next v If ErrMsg <> "" Then MsgBox "以下のシートが残っています。削除してから実行してください" & vbCrLf & ErrMsg Exit Sub End If
'シート作成 For Each v In Split(strSheets, ",") '★シートを作る・作らないの判定用 flgMKWS = False Select Case True Case 結果出力 = True flgMKWS = True Case v Like "計算用*" flgMKWS = True Case Else flgMKWS = False End Select If flgMKWS = True Then '★ループの中なので、別のプロシジャにしなくてもγさんのおっしゃるDRYの原則は守れている With Sheets.Add(after:=Sheets(Sheets.Count)) .name = v .Tab.Color = 16764159 .Range("A1") = Right(v, 1) End With End If Next v End Sub (稲葉) 2023/01/19(木) 13:24:41
>後から見てコードのわかりやすい書き方
コーディングする上で、気を付けているのは、 今回のシート追加や、他に、セルに書き出すとか 様々な出力のコードは可能な限り、1点として、 その前段で様々な条件、情報取得するようにしています。
出力は、ある意味そのプロシージャやコードの1ブロックの 実行結果となる場合が多いので、その結果に至る過程を 見ることで、可読性が上がるかと。
もう1つ大事なのは、コーディングルールだと思います。 プロシージャや変数が如何に的確な命名をするか、 変数のスコープや引数とかで、命名記法を統一するとか が大事です。
今回のコードで言えば、wSheet では、 変数名を見ただけでは、Sheetオブジェクトかな、と 思ってしまいます。
私は、ワークシート名が複数入っている変数としたかったので、 wsNames としました。 多少文字数が多くても構いません。
最後に変数宣言位置ですが、コードの先頭に持ってくると、 読みにくいと思うので、使用する直前に持ってきます。 ここは様々ですが。
コーディングにおいては、1か月後の自分は他人だと思って がんばってください。
(tkit) 2023/01/20(金) 08:50:06
> 最後に変数宣言位置ですが、コードの先頭に持ってくると、 > 読みにくいと思うので、使用する直前に持ってきます。 > ここは様々ですが。
これって本当なんですかね? そう言う人が増えている認識はありますけど。 私は、書くときはその都度、書き終わったらコード先頭に移動する方がいい気がするんですけど。
出来るなら、アルファベット順とか、データ型別アルファベット順とか、出現順とかがいいなぁ・・と。 ※先頭への移動は、自動インデンターで行きがけの駄賃でやって貰う。
(半平太) 2023/01/20(金) 12:03:18
変数宣言が、先頭か都度かは、プロシージャの コードライン数にもよると思います。
小説で例えるならば、目次に登場人物の説明があるのと、 初登場時に説明的な内容がある、の違いでしょうか。
C#やC++系も触っているからかと思いますが、 変数のスコープを意図するようにしたいから、 もあります。
実際のスコープは違うことは承知していますが、 ループ内でしか、使用しない変数はループ内で宣言します。
初学時は、先頭で宣言していましたが、 C#やC++系を学ぶ内、都度変数宣言したほうが、 初登場と何者かがハッキリするので、読み易いと思います。
様々ですが。
(tkit) 2023/01/20(金) 13:22:07
'条件により作成するシート名の取得
'シート名の分だけ繰り返し 'シートの追加 '次へ End Sub
大雑把に書くとやりたいことはこういう流れでは?
で、シート名とか追加とかは部下とか下請け(=子プロシージャ)に任せたらよい。
で、部下は与えられた仕事をどのように作業すればいいかを書いて行く。
Private Sub CommandButton1_Click()
Dim ss As String Dim s As String
'条件により作成するシート名の取得 s = Getシート名一覧取得
'シート名の分だけ繰り返し For Each s In Split(ss, ",") 'シートの追加 Setシートの追加 s '次へ End Sub
Function Getシート名一覧取得() As String
'オプションボタンの選択を取得 'チェックボックスの値を取得
'条件により名前の一覧を取得 End Function
Sub Setシートの追加(ByVal strシート名)
'同じシート名の存在確認 'もし、なかったら、新しくシートを追加して名前の変更 End Sub
日本語をVBAに翻訳して
Option Explicit
Private Sub CommandButton1_Click()
Dim ss As String Dim s As String
'条件により作成するシート名の取得 s = Getシート名一覧取得(Me.Range("O4").Value, Me.Range("O6").Value)
'シート名の分だけ繰り返し For Each s In Split(ss, ",") 'シートの追加 Setシートの追加 s '次へ End Sub
'動作確認用
Sub test()
Dim ss Dim s ss = Getシート名一覧取得(1, True) For Each s In Split(ss, ",") Setシートの追加 s Next End Sub
Function Getシート名一覧取得(ByVal o As Long, ByVal c As Boolean) As String
Dim s As String Dim n As Variant
'条件により名前の一覧を取得 For Each n In Array("計算用", "結果") If o = 1 Or 2 Then s = s & "," & n & "A" If o = 1 Or 3 Then s = s & "," & n & "B" If c = False Then Exit For Next
Getシート名一覧取得 = Mid(s, 2) End Function
Sub Setシートの追加(ByVal strシート名 As String)
Dim ws As Worksheet '同じシート名の存在確認 On Error Resume Next Set ws = Worksheets(strシート名) On Error GoTo 0
'もし、なかったら、新しくシートを追加して名前の変更 If ws Is Nothing Then With Worksheets.Add(after:=Worksheets(Worksheets.Count)) .Name = strシート名 .Tab.Color = vbGreen .Range("A1").Value = Right(strシート名, 1) End With End If End Sub
こんな感じかなぁと。
サンプルなのでいい加減です。
あとで読んで分かるよう変数名を工夫したり、
も少しコメント追加したりしたほうがよいかも。
こうやって考えていったら、
「Function Getシート名一覧取得」
このプロシージャの中身をどうすればいいかだけに注力できるかなと思ったり。。。。
(まっつわん) 2023/01/20(金) 17:40:19
tkitさん 稲葉さん 半平太さん まっつわんさん ありがとうございます
理解はできるのですが、 自分で一から考えて実践していこうとすると時間がかかりそうです… 読み返して練習していきたいと思います
時間がかかりそうですので、一旦お礼のみで失礼します ありがとうございました (see) 2023/01/23(月) 09:29:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.