| |
▼マスク さん：
>完成シートを見て、感動しました！
では、CSVに見出しがないときの処理を追加です。
Excelで開いたとき、[A1]セルが日付データだったら、一行挿入する
という処理を入れました。●の部分以降です。
Sub Filter_CSV2()
Dim myDate As Long '抽出したい日付 (シリアル値)
Dim myCSVs, f
Dim newBook As Workbook
Dim rCopy As Range '抽出転記先先頭セル
Dim myCol As Long
Dim NoHeader As Boolean '見出しはあるか
Dim i As Long
'抽出したい日付をこのマクロブックのSheet1!A1セルに書いておく
myDate = ThisWorkbook.Worksheets(1).Range("A1").Value2
'OpenするCSVファイルを（複数）指定
myCSVs = Application.GetOpenFilename("CSVファイル,*.csv", _
MultiSelect:=True)
If Not IsArray(myCSVs) Then Exit Sub
'抽出転記先のBookを作成
Set newBook = Workbooks.Add(xlWBATWorksheet) 'シート1枚
Set rCopy = newBook.Sheets(1).Range("A1") '最初の貼り付け先（セル）
'指定のCSVファイルを順に開いてフィルタ抽出
For Each f In myCSVs
With Workbooks.Open(f).Worksheets(1)
'表領域に対してA列の日付を抽出する
With .Range("A1")
myCol = .CurrentRegion.Columns.Count '表の列数
NoHeader = IsDate(.Value) '●見出し行あり/なし
End With
If NoHeader Then '見出し行が無かったら
'1行目に見出し行を挿入
.Rows(1).Insert
With .Rows(1).Cells
For i = 1 To myCol
.Item(i).Value = Chr$(&H40 + i) '仮の見出し
Next
End With
End If
'表領域に対してA列の日付を抽出する
With .Range("A1").CurrentRegion
.AutoFilter 1, ">=" & myDate, xlAnd, "<=" & myDate
If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
.Offset(1).Copy rCopy '1行目は除外してコピー
Set rCopy = rCopy.Offset(, myCol) '次の貼り付け先
End If
.AutoFilter
End With
.Parent.Close False '保存しないで閉じる
End With
Next
newBook.Close True '保存して閉じる
End Sub
>まずオートフィルタで抽出すればいいということから理解できてない
特定のアイテム行だけ抽出するために、フィルタを使うのですが、
今回のように 「日付のAutoFilter」は（文字列ではないので）ちょっと
気を付けないと抽出されません。
> myCri = InputBox("日付を入力して下さい")
>
> With Sh2
> .Range("A1").AutoFilter Field:=1, Criteria1:=myCri
こういうフィルタのかけ方をすると、まず抽出されません。理由は Inputbox
関数の返り値が文字列だから、
Criteria1:="8/31" という文字列の行を抽出しようとします。
正しく動くようにするには、Criteriaが数値になるようにします。
具体的には
Criteria1:=">=" & 日付, xlAnd, Criteria2:="<=" & 日付
のように、不等号で抽出したい日付を挟んでやります。
そして、与える日付 は 2013/8/31 のような日付型でなく、
41517 のような シリアル値にすれば「完璧」です。
以上のようにすれば、A列の日付の表示形式がどのようなものであろうと、
必ず抽出されるはずです。
|
|
kanabun
- 13/9/30(月) 10:51 -
