[[20190805025614]]　『データの抽出』（レイ）　ページの最後に飛ぶ

『データの抽出』（レイ）

フォルダ内にExcelファイル「ボタン」とcsvファイル「データ」
があります。
Excelファイルにボタンを配置してcsvファイルにあるデータを
条件を満たす行を抽出して別のcsvファイルとして出力するマクロを
作成したいのですが、知識が薄いので助けてください。

一応、いろいろ試してCSVファイルにマクロを作成して
見ましたがSheet2に出力するまではできたと思うのですが
あってるのかいまいちわかりません。

Sub Macro1()
Application.ScreenUpdating=false
Dim a
a=Application,Transpose(Range("U2:U"&Range("U1048576").
End(xlUp).Row).Value

a=Filter(a,"234".False)
a=Filter(a,"567".False)
a=Filter(a,"890".False)
a=Filter(a,"123".False)
a=Filter(a,"456".False)
a=Filter(a,"987".False)

With Range("A1")
.AutoFilter Field:=21,Criteria1=a,Operaator:=xlFilterValues
.AutoFilter Field:=34,Criteria1=12345,Operaator:=xlFilterValues
.CurrentRegion.Copy sheet("Sheet2").Range("A1")
.AutoFilter
End With

Application.ScreenUpdating=True
End Sub

※aの条件は全部で10個あります。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

＞あってるのかいまいちわかりません。

動かしては見たのでしょうか？
多分動かなかったと思いますが・・

コンパイルエラーが出ないように修正したコードが下記です
データの内容がわからないので、実行時の検証はできません

とりあえずこれで動かしてみては？

Sub Macro1()

    Application.ScreenUpdating = False
    Dim a

    a = Application.Transpose(Range("U2:U" & Range("U1048576").End(xlUp).Row)).Value

    a = Filter(a, "234", False)
    a = Filter(a, "567", False)
    a = Filter(a, "890", False)
    a = Filter(a, "123", False)
    a = Filter(a, "456", False)
    a = Filter(a, "987", False)

    With Range("A1")
        .AutoFilter Field:=21, Criteria1:=a, Operator:=xlFilterValues
        .AutoFilter Field:=34, Criteria1:=12345, Operator:=xlFilterValues
        .CurrentRegion.Copy Sheets("Sheet2").Range("A1")
        .AutoFilter
    End With

    Application.ScreenUpdating = True
End Sub

（渡辺ひかる） 2019/08/05(月) 09:12

説明が不足していてすみません。

同一フォルダ内にExcelファイル「ファイル名：ボタン」と
csvファイル「ファイル名：データ」があります。

Excelファイル「ファイル名：ボタン」にボタンを配置して
csvファイル「ファイル名：データ」にあるデータから
条件を満たす行だけを抽出して別のcsvファイル「ファイル名：データ2」
として出力するマクロを作成したかったのですが
方法が良くわからずcsvファイル「ファイル名：データ」をエクセルで開いて
マクロを試していた為、記載したマクロになってしまった次第です。
※なので出力先もSheet2となっています。

条件としましてはcsvファイルをExcelで開いたときにU2以降の行（U1は科目名）が
aの条件以外のものでかつAHの行に12345が入力されている以外の行が対象で別の
CSVふぁいるとして保存したいです。
分かりずらくてすみません。

（レイ） 2019/08/05(月) 11:47

＞csvファイル「ファイル名：データ」にあるデータから

ボタンをクリックする時点でcsvファイルは開かれているとして

以下のコードを「ボタン」の標準モジュールに貼り付けて、ボタンにマクロを登録して
実行してみてください
動作確認のためにApplication.ScreenUpdatingはコメントアウトしています。
データ2.csv の保存フォルダは「ボタン」と同じにしています。

Sub Macro1()

    'Application.ScreenUpdating = False
    Dim a
    Dim myCsvSht As Worksheet
    Dim myNewCsv As Workbook

    Set myCsvSht = Workbooks("データ.csv").Worksheets("Sheet1")
    Set myNewCsv = Workbooks.Add

    a = Application.Transpose(myCsvSht.Range("U2:U" & myCsvSht.Range("U1048576").End(xlUp).Row)).Value

    a = Filter(a, "234", False)
    a = Filter(a, "567", False)
    a = Filter(a, "890", False)
    a = Filter(a, "123", False)
    a = Filter(a, "456", False)
    a = Filter(a, "987", False)

    With myCsvSht.Range("A1")
        .AutoFilter Field:=21, Criteria1:=a, Operator:=xlFilterValues
        .AutoFilter Field:=34, Criteria1:=12345, Operator:=xlFilterValues
        .CurrentRegion.Copy myNewCsv.Sheets("Sheet1").Range("A1")
        .AutoFilter
    End With

    myNewCsv.SaveAs ThisWorkbook.Path & "\" & "データ2.csv", xlCSV
    myNewCsv.Close False
    'Application.ScreenUpdating = True
End Sub

（渡辺ひかる） 2019/08/05(月) 12:18

 >a=Filter(a,"234".False) 
 >a=Filter(a,"567".False) 
 >a=Filter(a,"890".False) 
 >a=Filter(a,"123".False) 
 >a=Filter(a,"456".False) 
 >a=Filter(a,"987".False)

 U列は全て3桁ですか？
 もしそうでなければ、問題ありです。

 元CSVから上記以外のデータで構成された新CSVを生成する。

 ということなら、ADO接続で出来ると思います。
 U列の列項目は何でしょう？
（seiya） 2019/08/05(月) 13:46

頂いた内容で試すと
a = Application.Transpose(myCsvSht.Range("U2:U" & myCsvSht.Range("U1048576").End(xlUp).Row)).Value

上記の所でオブジェクトが必要ですのエラーが帰って来てしまいます。

U列は全て3桁ですか？
＞＞いえ全てが3ケタではありません。8ケタくらいまであるものもあります。
（レイ） 2019/08/05(月) 13:57

 ＞＞いえ全てが3ケタではありません。8ケタくらいまであるものもあります。
 Filter関数は部分一致(含む)で判断します。
 問題ありませんか？
 U列の列項目はわかるのですか？
（seiya） 2019/08/05(月) 14:15

 Workbooks.Open メソッドで開いて問題ないなら AutoFilterで

 Sub test()
     Dim fn As String
     fn = Application.GetOpenFilename("CSVFiles,*.csv")
     If fn = "False" Then Exit Sub
     With Workbooks.Open(fn).Sheets(1)
         With .Cells(1).CurrentRegion
             .AutoFilter 21, Array("234", "567", "890", "123", "456", "987"), 7
             .Offset(1).EntireRow.Delete
             .AutoFilter 34,"<>12345" '<----
             .Offset(1).EntireRow.Delete '<---
             .Parent.AutoFilterMode = False
         End With
         With .Parent
             .SaveAs Replace(fn, ".csv", "_New.csv"), xlCSV
             .Close False
         End With
     End With
 End Sub

（seiya） 2019/08/05(月) 14:26

 2行追加 :

 Filter関数は部分一致(含む)で判断します。
 問題ありませんか？
 U列の列項目はわかるのですか？
＞＞U列の列項目は数値です。（頭が0はありません）
　　部分一致ですと確かに問題です。
（レイ） 2019/08/05(月) 14:38

＞上記の所でオブジェクトが必要ですのエラーが帰って来てしまいます。

検証不足でした。
下記のように変更してください

a = Application.Transpose(myCsvSht.Range("U2:U" & myCsvSht.Range("U1048576").End(xlUp).Row).Value)

（渡辺ひかる） 2019/08/05(月) 15:43

ありがとうございます！できました。
ちなみになんですがCSVファイルを閉じたまま同様の処理を行うことはできない
のでしょうか。

（レイ） 2019/08/07(水) 01:58

コメント返信：

[ 一覧(最新更新順) ]

[[20190805025614]] 『データの抽出』（レイ） ページの最後に飛ぶ

[[20190805025614]]　『データの抽出』（レイ）　ページの最後に飛ぶ