こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

現在、下記のようなコード書いて利用しています。
このコードを他の人がに転用する時に、指定箇所さえ書き換えれば簡単に転用できる!と言うようにしたいのです。
例えば
>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
-------------------------------------------------------------

投稿日時 - 2009-04-14 14:42:49

QNo.4878592

困ってます

質問者が選んだベストアンサー

>このコードを他の人がに転用する時に、指定箇所さえ書き換えれば簡単に転用できる!
汎用性を持たせたいと言うことかな

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

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

投稿日時 - 2009-04-15 16:51:45

お礼

こんな感じのイメージでした。
ありがとうございます。
"設定"する場所を頭にもってきて、まとめて定義しておきたかったです。

投稿日時 - 2009-04-30 09:35:06

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.6

コード内で設定せずに、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

投稿日時 - 2009-04-21 23:19:00

お礼

かなりプロフェッショナルなコードですね。
アドバイスありがとうございます。
試してみます!

投稿日時 - 2009-04-30 09:37:35

ANo.4

関数(手続きだけど)の例
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ページ目に書き方が簡潔に書いてありますので補足しません。

投稿日時 - 2009-04-14 18:13:51

お礼

さらに具体的にご説明いただきありがとうございます!

投稿日時 - 2009-04-30 09:32:25

ANo.3

なるほど。

・パラメータを与えるだけで動くような関数を作成するとか。
・クラスにしてしまうとか。

参考:
https://codezine.jp/article/detail/499

クラスにしてしまえば、表面のコードは、かなりシンプルになると思います。
クラスを作成するに当たって、手っ取り早いのは、最初にプロパティやメソッドなどの一覧をつくってしまいます。
で、あとから1つずつ、実装していけばよいです。

投稿日時 - 2009-04-14 16:37:19

お礼

ありがとうございます。
始めにまとめて一覧を作っておけば、他に転用するときも、一覧の箇所のみ変更すれば良いのですね!

投稿日時 - 2009-04-30 09:31:14

ANo.2

WDY

こんにちわ

どういう書き方がいい書き方かというのは分かりませんが
私がよく行う方法は
'---------○○○○○○○の設定-----------------

'---------○○○○○○○の設定ココまで-----------------
の様にブロック化してしまいます。
沢山コメントがあれば後で読んだ時に自分も分かるし
自分以外の人が修正する場合も分かりやすいと思います。

投稿日時 - 2009-04-14 14:51:20

お礼

アドバイスありがとうございます。
書き方が悪かったかもしれませんが、コードとしてスリム化したかったので、補足説明の「'~の」では目的が違ってしまいます…スミマセン

投稿日時 - 2009-04-14 14:56:06

ANo.1

Const a=1
Const b="string"

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

投稿日時 - 2009-04-14 14:50:18

補足

アドバイスありがとうございます!
Constを使ってスリム化しようと考えていました。
が、上手くいきません。CopydataはmyBookの中のSH1に存在するので、リンクだらけでどうConstを使って良いか困っています。
宜しければ具体的にアドバイスいただけると大変助かります。

>'他のBookを開いて変数に格納
>Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName)
>'転記元を取得(Z列1行を基点に100行コピー)
>Set SH1 = myBook.Worksheets("回答内容")
>Set Copydata = SH1.Range("Z1").Resize(100, 1)

投稿日時 - 2009-04-14 15:10:20

お礼

有難うございました。

投稿日時 - 2013-01-24 17:26:41

あなたにオススメの質問