Excel VBA質問箱 IV

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

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


7469 / 76736 ←次へ | 前へ→

【74854】Re:複数のCSVファイルを開き、抽出、別シートの空白セルに貼り付けしたい
発言  kanabun  - 13/9/30(月) 10:51 -

引用なし
パスワード
   ▼マスク さん:

>完成シートを見て、感動しました!

では、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列の日付の表示形式がどのようなものであろうと、
必ず抽出されるはずです。
2 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 お礼

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