「差込印刷」の編集履歴（バックアップ）一覧はこちら

「差込印刷」(2006/05/28 (日) 18:14:58) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

<p>Option Explicit</p>
<p>
'******************************************************************************<br>

'内容：検索条件を指定し、結果を出力する<br>
'******************************************************************************</p>
<p>Sub subFilter()</p>
<p>Dim BaseDir As String<br>
Dim InpFile As String<br>
Dim OutFile As String</p>
<p>Dim InpWkb As Workbook<br>
Dim OutWkb As Workbook</p>
<p>Dim rngInp As Range<br>
Dim rngJouken As Range<br>
Dim rngOut As Range</p>
<p><br>
'カレントパス取得<br>
BaseDir = ThisWorkbook.Path</p>
<p>InpFile = BaseDir &amp; "\" &amp; "台帳.xls"</p>
<p>OutFile = BaseDir &amp; "\" &amp; "フィルタテスト.xls"</p>
<p>Set rngJouken = ThisWorkbook.Sheets("work").Range("検索条件")<br>
Set rngOut = ThisWorkbook.Sheets("main").Range("C12")</p>
<p><br>
Set InpWkb = Workbooks.Open(InpFile)</p>
<p>Set rngInp = InpWkb.Sheets("台帳").Cells(1, 1).CurrentRegion</p>
<p>rngInp.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngJouken,
CopyToRange:=rngOut, Unique:=False</p>
<p>InpWkb.Close SaveChanges:=False</p>
<p>Set InpWkb = Nothing</p>
<p><br>
End Sub</p>
<br>