Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7468 / 76736 ←次へ | 前へ→

【74855】Re:複数のCSVファイルを開き、抽出、別シートの空白セルに貼り付けしたい
お礼  マスク  - 13/10/2(水) 21:55 -

引用なし
パスワード
   分かりやすい説明を何度も何度もありがとうございます。
Inputbox関数の返り値が文字列という説明には驚きました。
まだまだ知識不足を実感するばかりです。
本当にありがとうございました!!


▼kanabun さん:
>▼マスク さん:
>
>>完成シートを見て、感動しました!
>
>では、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列の日付の表示形式がどのようなものであろうと、
>必ず抽出されるはずです。
3 hits

【74845】複数のCSVファイルを開き、抽出、別シートの空白セルに貼り付けしたい マスク 13/9/29(日) 10:34 質問
【74847】Re:複数のCSVファイルを開き、抽出、別... kanabun 13/9/29(日) 17:29 発言
【74848】Re:複数のCSVファイルを開き、抽出、別... マスク 13/9/29(日) 18:35 質問
【74849】Re:複数のCSVファイルを開き、抽出、別... kanabun 13/9/29(日) 19:11 発言
【74850】Re:複数のCSVファイルを開き、抽出、別... マスク 13/9/29(日) 19:45 質問
【74851】Re:複数のCSVファイルを開き、抽出、別... kanabun 13/9/29(日) 20:08 質問
【74852】Re:複数のCSVファイルを開き、抽出、別... マスク 13/9/29(日) 21:23 お礼
【74854】Re:複数のCSVファイルを開き、抽出、別... kanabun 13/9/30(月) 10:51 発言
【74855】Re:複数のCSVファイルを開き、抽出、別... マスク 13/10/2(水) 21:55 お礼

7468 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free