[[20230119094024]] 『 (2) 後から見てコードのわかりやすい書き方』(see) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『 (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 >


こんな感じでしょうか。
Activesheetである必要はあるのでしょうか?
ブック、シート決まっているなら、必ず指定したほうがいいでしょう。

シート削除を入れてあります。
また、通知の場合のコードはコメントアウトしています。

  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


Private Sub CommandButton1_Click()
    '条件により作成するシート名の取得

    'シート名の分だけ繰り返し
        'シートの追加
    '次へ
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.