エクセルでマクロを作って汎用的にするには工夫が必要です。
私は、「入力」とか「main」とかのワークシートを追加します。このワークシートはワークシートの一番左に置きます。また、「管理用」とか「管理」、「補助」、「補助シート」、「Library」などマクロで使うリストや管理用のデータを置くワークシートを一番右に置きます。「管理」用のワークシートは、入力や見る必要が無いので普段は非表示にしていてもいいでしょう。
前回の例を少し汎用的にします。入力用のセルは黄色にしてます。
ActiveXの方のコマンドボタン、リストボックスを使いました。コード内にExcelの名前を使っています。
名前のデータは、Range(名前)で値を取り出せるが、他のワークブックではできない。
ワークブックオブジェクト.Names(名前).RefersToRange
で他のワークブックの名前の値を取り出せる。
標準モジュールのコード。このコードはそのままカトペでOK
Option Explicit
Dim pwb As Workbook, cwb As Workbook
Sub main()
myChdir
getXlsFile
myCopy
End Sub
Sub myChdir()
’VBA.ChDir VBA.Replace(VBA.CurDir, "Documents", "Downloads")
VBA.ChDir VBA.Environ("USERPROFILE") & "\downloads"
Sheet4.Range("c1") = VBA.CurDir
End Sub
Sub getXlsFile()
myChdir
Dim x
x = VBA.Dir(Range("ワイルドカード"))
Sheet4.ListBox1.Clear
Do Until "" = x
Sheet4.ListBox1.AddItem x
x = Dir
Loop
If 0 = Sheet4.ListBox1.ListCount Then
Sheet4.ListBox1.AddItem "ダウンロードフォルダ"
Sheet4.ListBox1.AddItem "に"
Sheet4.ListBox1.AddItem Range("ワイルドカード")
Sheet4.ListBox1.AddItem "で検索できるファイルが"
Sheet4.ListBox1.AddItem "ありますか?"
End If
End Sub
Sub myCopy()
myChdir
Set cwb = Excel.Workbooks.Add(Range("読み込みファイル"))
Set pwb = ThisWorkbook
Dim s As String
s = pwb.Names("コピー元ワークシート").RefersToRange
cwb.Worksheets(s).Select
s = pwb.Names("コピー元検索列").RefersToRange
Excel.Range(s & "1").Select
Do Until Excel.ActiveCell = pwb.Names("コピー元検索文字列").RefersToRange
Excel.ActiveCell.Offset(1, 0).Select
Loop
Excel.Range(Excel.ActiveCell.Offset(0, 1), Excel.ActiveCell.Offset(0, 7)).Select
Selection.Copy
pwb.Activate
s = Range("入力ワークシート")
Sheets(s).Select
s = Range("コピー先検索列") & "1"
Excel.Range(s).Select
Do Until Range("コピー先検索文字列") = Excel.ActiveCell
Excel.ActiveCell.Offset(1, 0).Select
Loop
Excel.ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
cwb.Close
End Sub
Sheet4のコード。CommandButton1_Click()のような_アンダーバーの入るプロシージャはイベントです。ですからその文字列は書きません。プロシージャ/イベント ボックスで選択して入れます。Sheet4のコードは全部イベントプロシージャです。プロシージャボックスはイベントボックスでもあります。
Option Explicit
Private Sub CommandButton1_Click()
getXlsFile
Worksheet_Activate
End Sub
Private Sub CommandButton2_Click()
myCopy
End Sub
Private Sub ListBox1_Click()
Range("読み込みファイル") = Me.ListBox1.Text
End Sub
Private Sub ListBox2_Click()
Range("入力ワークシート") = Me.ListBox2.Text
End Sub
Private Sub Worksheet_Activate()
Me.CommandButton1.Caption = "読み込みファイル一覧"
Me.ListBox1.BackColor = VBA.vbYellow
Me.CommandButton2.Caption = "実行"
Me.ListBox2.BackColor = VBA.vbYellow
Dim sh As Worksheet
Me.ListBox2.Clear
For Each sh In ThisWorkbook.Worksheets
Me.ListBox2.AddItem sh.Name
Next
End Sub
(Visited 134 times, 1 visits today)