VBA　簡潔なコードを書くために

Question

現在、下記のようなコード書いて利用しています。このコードを他の人がに転用する時に、指定箇所さえ書き換えれば簡単に転用できる！と言うようにしたいのです。例えば＞Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName) ＞Set Copydata = SH1.Range("Z1").Resize(100, 1) といった指定するような箇所（" "で囲った所）を先にまとめて定義しておくにはどう記述したらよいのでしょうか。宜しくお願いします。 ------------------------------------------------------------- Private Sub 読込ボタン_Click() '他のBookからデータを転記するマクロ Dim SH2 As Worksheet, SH1 As Worksheet Dim GYO As Range, Copydata As Range Dim myDir As String, myName As String, myBook As Workbook Set SH2 = ThisWorkbook.Worksheets("情報シート") '集計用のBookがあるフォルダ名を指定(このBookを格納している場所) myDir = ThisWorkbook.Path '他Bookのファイル名を指定(*.xls) myName = Dir(myDir & "\" & "*.xls") Do While myName <> "" 'このBook以外を対象 If myName <> ThisWorkbook.Name Then '転記先[情報シート]の最終行を取得 Set GYO = SH2.Range("A65536").End(xlUp).Offset(1) '他のBookを開いて変数に格納 Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName) '転記元を取得(Z列1行を基点に100行コピー) Set SH1 = myBook.Worksheets("回答内容") Set Copydata = SH1.Range("Z1").Resize(100, 1) '転記先の最終次行に転記(行列入替で貼付) Copydata.Copy GYO.PasteSpecial Paste:=xlPasteValues, Transpose:=True '開いた他Bookを閉じる myBook.Close End If myName = Dir() Loop End Sub -------------------------------------------------------------

hige_082 · Accepted Answer

＞このコードを他の人がに転用する時に、指定箇所さえ書き換えれば簡単に転用できる！

汎用性を持たせたいと言うことかな

Private Sub 読込ボタン_Click() '他のBookからデータを転記するマクロ

Dim SH2 As Worksheet, SH1 As Worksheet
Dim GYO As Range, Copydata As Range
Dim myDir As String, myName As String
Dim myBook As Workbook

Dim SH2_Name As String, SH1_Name As String
Dim Copydata_Home As String

'設定開始---------------------------------------
SH2_Name = "情報シート" '転記先シート名
SH1_Name = "回答内容" '転記元シート名
Copydata_Home = "Z1" '転記元の基点（セル）を指定
'設定終了---------------------------------------

Set SH2 = ThisWorkbook.Worksheets(SH2_Name)
'集計用のBookがあるフォルダ名を指定(このBookを格納している場所)
myDir = ThisWorkbook.Path
'他Bookのファイル名を指定(*.xls)
myName = Dir(myDir & "\" & "*.xls")
Do While myName <> ""
'このBook以外を対象
If myName <> ThisWorkbook.Name Then
'転記先[情報シート]の最終行を取得
Set GYO = SH2.Range("A65536").End(xlUp).Offset(1)
'他のBookを開いて変数に格納
Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName)
'転記元を取得(Z列1行を基点に100行コピー)
Set SH1 = myBook.Worksheets(SH1_Name)
Set Copydata = SH1.Range(Copydata_Home).Resize(100, 1)
'転記先の最終次行に転記(行列入替で貼付)
Copydata.Copy
GYO.PasteSpecial Paste:=xlPasteValues, Transpose:=True
'開いた他Bookを閉じる
myBook.Close
End If
myName = Dir()
Loop
End Sub

設定開始～設定終了の間の３行を設定すれば、後は変更することなく
マクロを実行できますで良いのかな？

end-u · Answer

コード内で設定せずに、InputBoxを使って対話式にしたりとか、

Sub 例えば()
　　With Sheets.Add
　　　　.Name = "config"
　　　　.Range("A1:B1").Value = [{"フォルダ選択？（しない場合はこのBookのフォルダ）","yes"}]
　　　　.Range("A2:B2").Value = [{"転記先シート名？","情報シート"}]
　　　　.Range("A3:B3").Value = [{"転記元シート名？","回答内容"}]
　　　　.Range("A4:B4").Value = [{"転記元のセル？","Z1"}]
　　End With
End Sub

こんな「設定用シート」みたいな感じで外に出して、このシートを修正してもらい、
VBAからはその「設定用シート」の値を変数に取り込んで実行したりとか、も、考えられますね。

Option Explicit

Sub test()
　　Dim SH　　　As Worksheet
　　Dim SH1　　 As Worksheet
　　Dim SH2　　 As Worksheet
　　Dim GYO　　 As Range
　　Dim myDir　 As String
　　Dim myName　As String
　　Dim shtName As String
　　Dim kiten　 As String

　　With ThisWorkbook
　　　　On Error GoTo errHndr
　　　　Set SH = .Sheets("config")
　　　　Set SH2 = .Sheets(SH.Range("B2").Value)
　　　　On Error GoTo 0
　　　　shtName = SH.Range("B3").Value
　　　　kiten = SH.Range("B4").Value
　　　　If SH.Range("B1").Value = "yes" Then
　　　　　　myDir = FDSELECT
　　　　Else
　　　　　　myDir = .Path
　　　　End If
　　End With
　　If Len(myDir) = 0& Then Exit Sub
　　Application.ScreenUpdating = False
　　myName = Dir(myDir & "\" & "*.xls")
　　Do While myName <> ""
　　　　'このBook以外を対象
　　　　If myName <> ThisWorkbook.Name Then
　　　　　　'転記先シートの最終行を取得
　　　　　　Set GYO = SH2.Range("A65536").End(xlUp).Offset(1)
　　　　　　'他のBookを開く
　　　　　　With Workbooks.Open(Filename:=myDir & "\" & myName, ReadOnly:=True)
　　　　　　　　On Error Resume Next
　　　　　　　　Set SH1 = .Worksheets(shtName)
　　　　　　　　On Error GoTo 0
　　　　　　　　If Not SH1 Is Nothing Then
　　　　　　　　　　'転記元を取得(?列1行を基点に100行コピー)
　　　　　　　　　　SH1.Range(kiten).Resize(100).Copy
　　　　　　　　　　'転記先の最終次行に転記(行列入替で貼付)
　　　　　　　　　　GYO.PasteSpecial Paste:=xlPasteValues, Transpose:=True
　　　　　　　　　　Application.CutCopyMode = False
　　　　　　　　　　Set SH1 = Nothing
　　　　　　　　End If
　　　　　　　　'開いた他Bookを閉じる
　　　　　　　　.Close False
　　　　　　End With
　　　　End If
　　　　myName = Dir()
　　Loop

errHndr:
　　Application.ScreenUpdating = True
　　If Err.Number <> 0 Then MsgBox "設定シートがありません。処理中止"
　　Set GYO = Nothing
　　Set SH = Nothing
　　Set SH2 = Nothing
End Sub
'---------------------------------------------------------------------
Private Function FDSELECT() As String 'フォルダ選択Function
　　Dim obj As Object
　　Dim ret As String

　　Set obj = CreateObject("Shell.Application") _
　　　　　　　.BrowseForFolder(0, "SelectFolder", 0)
　　If obj Is Nothing Then Exit Function
　　On Error Resume Next
　　ret = obj.self.Path & "\"
　　If Err.Number <> 0 Then
　　　　ret = obj.Items.Item.Path & "\"
　　　　Err.Clear
　　End If
　　On Error GoTo 0
　　Set obj = Nothing
　　FDSELECT = ret
End Function

INTLINSIDE · Answer

関数（手続きだけど）の例
Private Sub 読込ボタン_Click() 
    
    LoadingHandler(myDir & "\" & myName,"Z1")
    
End Sub

Sub LoadingHandler( AFileName As String _
                   ,ARange As String)
    省略
      Set myBook = Workbooks.Open(Filename:=AFileName)
      Set Copydata = SH1.Range(ARange).Resize(100, 1)
    省略
End Sub

クラスは、さっきのURLの2ページ目に書き方が簡潔に書いてありますので補足しません。

INTLINSIDE · Answer

なるほど。

・パラメータを与えるだけで動くような関数を作成するとか。
・クラスにしてしまうとか。

参考：
https://codezine.jp/article/detail/499

クラスにしてしまえば、表面のコードは、かなりシンプルになると思います。
クラスを作成するに当たって、手っ取り早いのは、最初にプロパティやメソッドなどの一覧をつくってしまいます。
で、あとから１つずつ、実装していけばよいです。

WDY · Answer

こんにちわ

どういう書き方がいい書き方かというのは分かりませんが
私がよく行う方法は
'---------○○○○○○○の設定-----------------

'---------○○○○○○○の設定ココまで-----------------
の様にブロック化してしまいます。
沢山コメントがあれば後で読んだ時に自分も分かるし
自分以外の人が修正する場合も分かりやすいと思います。

INTLINSIDE · Answer

Const a=1
Const b="string"

で、それを使う場所で a とか b を参照するようにすれば、よろしいかと。

VBA 簡潔なコードを書くために

＞このコードを他の人がに転用する時に、指定箇所さえ書き換えれば簡単に転用できる！

コード内で設定せずに、InputBoxを使って対話式にしたりとか、

関数（手続きだけど）の例

なるほど。

こんにちわ

Const a=1

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

VBA　簡潔なコードを書くために