[[20170110183547]] 『CSV ファイルを開く』(超初心者) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『CSV ファイルを開く』(超初心者)

いつも大変お世話になっております。

エクセルにあるデータ(csv)を上から順に開き処理を行いたいのですが、うまくcsvデータが開きません。

やりたいことは下記です。

1.エクセルa4〜に対象データが入っています。
それを上から順に開き元データへコピー完了
但し、a4に入っているデータを含む名前のcsvとなっています。

2.開くデータはランダムで、b列は空白、c列はfalse、d列は#N/Aの場合のみ開きたいです。

3.開くデータは対象エクセルと同列にある"フォルダ"に入っています

超初心者の為足りないデータありましたら申し訳ございません。
ご教示頂きたく宜しくお願い致します。

Sub 対象csvを開く()

 Dim vv
 Dim h
 Dim i As Long
 Dim Fname As String
 Dim Sname As String
 Dim fp
 Dim vntFileName As Variant
 Dim FSO As Object, Folder As Variant
 Dim buf  As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    fp = ThisWorkbook.Path
    i = 1

  vv = Range("a4").End(xlDown).Row '最終行取得

 Range("A4" & f).Select

 If ActiveCell.Offset(1, 0) = "" And Not InStr(ActiveCell, Value) > 0 And ActiveCell.Offset(3, 0) = "#N/A" And Not InStr(ActiveCell, Value) > 0 Then 'bが空白,
 d列は# N / Aだった場合
    h = ActiveCell
    Fname = fp & "\" & "フォルダ"
    Sname = Dir(Fname & "*.csv")

    Open Fname & "\" & "*" & h & "*.csv" For Random As #1

    Line Input #1, buf

    Close #1

End Sub

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 >>    Range("A4" & f).Select

 この f って 何ですか?

(β) 2017/01/10(火) 20:37


 追加で

 >>それを上から順に開き元データへコピー完了 

 元データって何ですか? コピー完了 って 何ですか?

 >>開くデータはランダムで、b列は空白、c列はfalse、d列は#N/Aの場合のみ開きたいです。

 ここでいう B列とかC列とか D列って、A列に csvファイル名が入っているシートの領域ですか?

(β) 2017/01/10(火) 20:43


β様

コメントありがとうございます。

fは元々For f = 4 To 10000をしようとしていた時の残骸です、スミマセン。

元データはa4〜対象データが入っているデータの事です。

開くデータはランダムで、b列は空白、c列はfalse、d列は#N/Aの場合のみ開きたいです。 データは下記の様になっております。

a
xxxxxxx
yyyyyyy
zzzzzzz

上記データがあるとして、データ名は、"NNNNNxxxxxxxMMMMMMM"となっております。
この"NNNNNxxxxxxxMMMMMMM"を開き全コピー⇒貼りつけ⇒閉じる を行いたいです。

ここでいう B列とかC列とか D列って、A列に csvファイル名が入っているシートの領域ですか?⇒その通りです。

b列には、開き全コピー⇒貼りつけ⇒閉じるを行ったら済を入れようと思っております。
c列には、同じ品番があるかどうかの関数を組んでいます。
d列には作業対象かどうかの関数を組んでいます。

宜しくお願い致します。

(超初心者) 2017/01/11(水) 07:51


 ActiveCell.Offset(1, 0).Address を確認してみてください。
(cai) 2017/01/11(水) 08:48

 たとえば

    |[A] |[B]|[C]  |[D] 
 [4]|aaa1|   |FALSE|#N/A
 [5]|bbb1|   |TRUE |#N/A
 [6]|zzz1|   |FALSE|    
 [7]|ccc1|   |FALSE|#N/A

 こんなように記載があったとしたら、対象のcsvファイルは aaa1.csv 、ccc.csv ということになりますか?

 >>上記データがあるとして、データ名は、"NNNNNxxxxxxxMMMMMMM"となっております。 

 これが全く意味不明です。

 >>それを上から順に開き元データへコピー完了 

 質問への回答がないので再度。
 その csvファイルをどこに(どのシートのどこに、どのように)取り込みたいのですか?

(β) 2017/01/11(水) 09:14


β様

何度も申しわけございません、ありがとうございます。

こんなように記載があったとしたら、対象のcsvファイルは aaa1.csv 、ccc.csv ということになりますか?

aaa1 の頭と最後に不特定の文字が追加されています。
aaa1 でしたら たとえば VVVaaa1ZZZ.csv のような形です。

それを上から順に開き元データへコピー完了 何度も確認下さりもうし訳ございません。

開いたcsvファイルはマウス作業ですとドラッグして元のエクセルの最終シート(右端)へ移動したいです。

スミマセン、これでお分かりになりますでしょうか・・・・?
(超初心者) 2017/01/11(水) 09:24


 そうすると、私がアップした例でいえば

 ファイル名に aaa1 を含むcsvファイルをすべて、ccc1 を含むファイルをすべて取り込むということですね。
 それらを最終シートに、連続してすべて取り込むということでいいのですね?

 その前提でコードを書いてみますので、ちょがっていれば、早めに連絡してください。

(β) 2017/01/11(水) 09:35


β様

ファイル名に aaa1 を含むcsvファイルをすべて、ccc1 を含むファイルをすべて取り込むということですね。
それらを最終シートに、連続してすべて取り込むということでいいのですね?⇒はいその通りです。

データaaa1を含むcsvは1つしか無いので大丈夫です。

ありがとうございます、宜しくお願い致します。
(超初心者) 2017/01/11(水) 09:54


 要件誤解していたら指摘ください。

 なお、元シート、以下のコードでは Sheet1 にしてあります。
 そうではなく、実行する時点のアクティブしーとにしたければ

 With Sheets("Sheet1")   '★参照シート

 これを

 With ActiveSheet        '★参照シート

 にしてください。

 Sub Test()
    Dim shT As Worksheet
    Dim fPath As String
    Dim fName As String
    Dim c As Range
    Dim pos As Range
    Dim csv As Workbook

    Application.ScreenUpdating = False

    Set shT = ThisWorkbook.Sheets(ThisWorkbook.Worksheets.Count) '★集約シート
    shT.Cells.ClearContents
    Set pos = shT.Range("A1")   '転記開始位置
    fPath = ThisWorkbook.Path & "\フォルダ\"

    With Sheets("Sheet1")   '★参照シート
        For Each c In .Range("A4", .Range("A" & Rows.Count).End(xlUp))
            With c.EntireRow
                If .Range("B1") = "" Then
                    If .Range("C1").Value = False Then
                        If WorksheetFunction.IsNA(.Range("D1")) Then
                            fName = Dir(fPath & "*" & c.Value & "*.csv")
                            If fName <> "" Then
                                With Workbooks.Open(fPath & fName).Sheets(1)
                                    With .Range("A1", .UsedRange)
                                        .Copy pos
                                        Set pos = pos.Offset(.Rows.Count)
                                    End With
                                    .Parent.Close False
                                End With
                            End If
                        End If
                    End If
                End If
            End With
        Next
    End With

 End Sub

(β) 2017/01/11(水) 10:09


 ↑ 要件勘違いがあるかもしれませんが、おおむねOKだとして、最終シートをクリアした上で貼り付けています。
   そうではなく、すでに何らかの貼付けがあって、その下に加えていくということなら

    shT.Cells.ClearContents
    Set pos = shT.Range("A1")   '転記開始位置

  これを消し、かわりに

    If WorksheetFunction.CountA(shT.UsedRange) = 0 Then
        Set pos = shT.Range("A1")
    Else
        Set pos = shT.UsedRange(shT.UsedRange.Count).EntireRow.Range("A2")
    End If

  ついでに、抽出して貼り付けたファイル情報の B列に 済 と記載するなら

    .Parent.Close False

  この下あたりに

    c.EntireRow.Range("B1").Value = "済"

  を追加してください。

(β) 2017/01/11(水) 11:56


β様

御対応ありがとうございました。下記ご教示頂けないでしょうか?

設定して頂いたb1,c1,d1 は a4 のデータを確認(csvを取得)する時は b4,c4,d4 になり1行ずつずれていくため(a5のデータを取得する場合はb5,c5,d5になります)Offsetにしましたがエラ-1004で作動しませんでした。

cがセル値を取得していないのが原因かと思っていますがどのように変えれば良いでしょうか?

宜しくお願い致します。

(超初心者) 2017/01/11(水) 13:45


 実際に動かしたコードをそのままアップしてください。

(β) 2017/01/11(水) 13:51


 なお、ちょっとわかりにくかったかもしれませんが
 With c.EntireRow

 このように 当該セルの行でくくっています。
 ですから c が A4 なら .Range("B1") は B4 になりますし、 c が A5 なら .Range("B1") は B5 になります。

 >>1行ずつずれていくため

 この意味がわかりません。そのまま実行したらずれたのでコードを直したということですか?

(β) 2017/01/11(水) 13:55


β様

すみません、そのままで作動しました!余計な事しました

ただ、CSVは開くのですが、コピーされずそのままcloseされてしまうのですが、すみません私の説明が悪かった様で申し訳ござません。

開いたCSVをSHEETごと、With ActiveSheet '★参照シート へ移動したいのですが可能でしょうか?
(超初心者) 2017/01/11(水) 14:40


すみません、又どこへが抜けていました

開いたCSVをSHEETごと、With ActiveSheet '★参照シート の右端へ移動したいのですが
(超初心者) 2017/01/11(水) 14:42


 勘違いしてましたかね?

 アップしたコードは csvファイルを開き、その1行目からデータ最終行までの行を
 マクロブックの最後のシートに、上から順に 追加していっています。

 csvファイルが2つあって最初が20行、次が30行だとしたら、最後のシートに、50行貼り付けられます。

 そうではなく、csvファイルごとに、マクロブックの最後に、csvファイルのシートをそのまま
 どんどん追加していきたいということでしょうか?
 (csvファイルが2つあれば、マクロブックの末尾に新規シートが2つできあがる?)

 >>参照シート の右端

 定義を明確にしてください。
 参照シート(ActiveSheet?)の、同じシートの右のほうの列?
 参照シートとは別のシート(新規シート?)

(β) 2017/01/11(水) 15:38


β様

何度もありがとうございます。

そうではなく、csvファイルごとに、マクロブックの最後に、csvファイルのシートをそのまま

 どんどん追加していきたいということでしょうか?
 (csvファイルが2つあれば、マクロブックの末尾に新規シートが2つできあがる?)→その通りです。

参照シート の右端

 定義を明確にしてください。
 →参照シートとは別のシート(新規シートです)

何をお答えすれば良いかが分からない為何度も申し訳ございません。宜しくお願い致します。

(超初心者) 2017/01/11(水) 16:14


 う・・・・ん・・・

 それでは、以下を試して、要望通りなのか違うのかを確認願います。
 (17:50 該当ファイルは1つだけでしたね。コードをちょっと変更しました)

 Sub Test2()
    Dim fPath As String
    Dim fName As String
    Dim c As Range

    Application.ScreenUpdating = False

    fPath = ThisWorkbook.Path & "\フォルダ\"

    With Sheets("Sheet1")   '★参照シート
        For Each c In .Range("A4", .Range("A" & Rows.Count).End(xlUp))
            With c.EntireRow
                If .Range("B1") = "" Then
                    If .Range("C1").Value = False Then
                        If WorksheetFunction.IsNA(.Range("D1")) Then
                            fName = Dir(fPath & "*" & c.Value & "*.csv")
                            If fName <> "" Then
                                With Workbooks.Open(fPath & fName).Sheets(1)
                                    .Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                                    .Parent.Close False
                                    c.EntireRow.Range("B1").Value = "済"
                                End With
                            End If
                        End If
                    End If
                End If
            End With
        Next
    End With

 End Sub

(β) 2017/01/11(水) 17:03


 ↑ なお、フォルダ名は、そちらのコードにあったように 半角カタカナの フォルダ にしていますが
   もし、全角の フォルダ という名前なら、ここを直してくださいね。
   (一般的に、何によらず、名前に 半角カタカナは使わないほうがいいですよ)

(β) 2017/01/11(水) 17:54


β様

何度もお世話になりありがとうございました。
無事マクロが動きました!

余談ですが、私もβ様のようにマクロが分かる様になりたいのですが、β様はどのようにVBA取得されたか教えて頂けませんか?
(超初心者) 2017/01/12(木) 07:40


 例えば

[[20160227004320]] 『マクロの勉強の仕方について』(あいり)

 こんなトピが参考になるのではないでしょうか。

 その他にも、↑のトピでコメントに入れていますが、学校内の全文検索で
 勉強法 を検索語にして検索してみてください。
 参考トピが列挙されます。

(β) 2017/01/12(木) 17:57


β様

積み重ねですね、色々勉強になりました。

又ご教示頂けたら幸いです、β様皆様ボランティアの様な活動かと思いますが感謝感謝です。

私もβ様の様になれるよう頑張りたいと思います。ありがとうございました。
(超初心者) 2017/01/12(木) 19:55


どなたか分かる方いらっしゃいましたらご教示をお願い致します。

以前にβ様にマクロをご教示頂き変更をしたものが下記になります。
34行目に If InStr(c.Offset(0, 2), "MAST G*") <> 0 Then という文があるのですが
この"MAST G*" が"BOARD G*"も拾ってきてしまいます。
何故なのかわからず苦慮しております。
どなたか解りましたらお助け下さい。
宜しくお願い致します。

1 With Sheets("チェック_入力用シート") '★参照シート
2
3 Dim tx As String
4 Dim Rng As Range
5
6 tx = ActiveCell.Value
7
8 Dim c As Range
9 Dim r As Range
10 Dim myKey As String
11 Dim nxtsh As Worksheet
12
13 Application.ScreenUpdating = False
14
15 'With Worksheets("チェック_入力用シート").Active '★参照シート
16
17 Set nxtsh = Worksheets("チェック_入力用シート").Next
18
19 Set Rng = Sheets("チェック_入力用シート").Range("b:b").Find(What:=tx)
20
21 For Each c In .Range(Rng, .Range("b" & Rows.Count).End(xlUp))
22
23 With c.EntireRow
24
25 If c <> "" Then
26
27 If c.Offset(0, 5) = "" Then
28
29 Set r = nxtsh.Columns("e:e").Find(c, LookAt:=xlWhole)
30 If r Is Nothing Then
31
32 If c.Offset(0, 4) = "" Then
33
34 If InStr(c.Offset(0, 2), "MAST G*") <> 0 Then
35
36 i = Worksheets("確認シート").Range("d6") + 1
37 a = "作成_" & i
38 c.Offset(0, 5) = a
39 Worksheets("確認シート").Range("d6") = i
40
41 Set rnga = Sheets("チェック_入力用シート").Range("g:g").Find(What:=a)
42
43 Range(rnga, rnga.Offset(0, -6)).Copy
44
45 Call チェックシートへ反映
46
47 Else
48 End If
49
50 End If
51 Else
52 c.Offset(0, 5) = r.Offset(0, -3).Value
53
54 'c.EntireRow.Range("B1").Value = "済"
55 End If
56
57 'End With
58 'End If
59 End If
60 'End If
61 End If
62 End With
63 'End If
64 Next
65 Set Rng = Sheets("?@作成ユニット一覧").Range("A:A").Find(What:=tx)
66 If Rng Is Nothing Then
67 MsgBox "UNIT品番が見つかりませんでした。"
68 Else
69 Worksheets("?@作成ユニット一覧").Select
70 Rng.Offset(0, 1) = "済"
71 End If
72 End With

(超初心者) 2017/01/19(木) 21:01


やりたい内容は、MAST Gから始まる場合はELSE です。

どうぞ宜しくお願い致します。
(超初心者) 2017/01/19(木) 21:03


言葉が変でした。
MAST Gから始まる場合は何もしない、です。
(超初心者) 2017/01/19(木) 21:04

 >34行目に If InStr(c.Offset(0, 2), "MAST G*") <> 0 Then という文があるのですが 
 >この"MAST G*" が"BOARD G*"も拾ってきてしまいます。 
 >何故なのかわからず苦慮しております。 

 この部分は私がアップした参考コードにはありませんので、ご自分で調べて追加されたんですね。

 そのセル内に "MAST G*" という文字列が、どこにもないのに拾ってくるということはありえません。

 If InStr(c.Offset(0, 2), "MAST G*") <> 0 Then

 このコードの下に

 MsgBox c.Offset(0, 2).Value

 といれて、実行して、本当に、メッセージで表示される文字列の中に "MAST G*" がないか
確認してください。

( β) 2017/01/19(木) 21:54


 それから、アップされたコードは、質問用に、あえて コードを左よせにしているんですね?

 まさか、本物のコードも、左寄せにしているのではないですね?
 もし、本物のコードも左寄せにしているとすれば、そうした(左寄せにした)理由をきかせてください。

( β) 2017/01/19(木) 21:57


β様

いつも大変お世話になりありがとうございます。

If InStr(c.Offset(0, 2), "MAST G*") <> 0 Then
の下に MsgBox c.Offset(0, 2).ValueをいれたのですがMsgBox が出てきませんでした。

又、マクロを動かしていると、"BOARD G.,F/M,H,FV,40,W1170,BETU"は"MAST G*"として認識しませんでしたが

"BOARD G.,40 VSB-GL"は"MAST G*"として認識し、elseへ飛んでしまいました。

アップしたコードの仕方ですが、ナンバーを振りたくてエクセルにa列にナンバー、b列にマクロを貼りつけした所ここでは左寄せになってしまいました。

左寄せにならず、ナンバーを入れる方法がありましたら合わせて御教示頂けますと幸いです。

宜しくお願い致します。

1 With Sheets("チェック_入力用シート") '★参照シート
2
3 Dim tx As String
4 Dim Rng As Range
5
6 tx = ActiveCell.Value
7
8 Dim c As Range
9 Dim r As Range
10 Dim myKey As String
11 Dim nxtsh As Worksheet
12
13 Application.ScreenUpdating = False
14
15 'With Worksheets("チェック_入力用シート").Active '★参照シート
16
17 Set nxtsh = Worksheets("チェック_入力用シート").Next
18
19 Set Rng = Sheets("チェック_入力用シート").Range("b:b").Find(What:=tx)
20
21 For Each c In .Range(Rng, .Range("b" & Rows.Count).End(xlUp))
22
23 With c.EntireRow
24
25 If c <> "" Then
26
27 If c.Offset(0, 5) = "" Then
28
29 Set r = nxtsh.Columns("e:e").Find(c, LookAt:=xlWhole)
30 If r Is Nothing Then
31
32 If c.Offset(0, 4) = "" Then
33
34 If InStr(c.Offset(0, 2), "MAST G*") <> 0 Then
35 MsgBox c.Offset(0, 2).Value
36
37 i = Worksheets("確認シート").Range("d6") + 1
38 a = "作成_" & i
39 c.Offset(0, 5) = a
40 Worksheets("確認シート").Range("d6") = i
41
42 Set rnga = Sheets("チェック_入力用シート").Range("g:g").Find(What:=a)
43
44 Range(rnga, rnga.Offset(0, -6)).Copy
45
46 Call チェックシートへ反映
47
48 Else
49 End If
50
51 End If
52 Else
53 c.Offset(0, 5) = r.Offset(0, -3).Value
54
55 'c.EntireRow.Range("B1").Value = "済"
56 End If
57
58 'End With
59 'End If
60 End If
61 'End If
62 End If
63 End With
64 'End If
65 Next
66 Set Rng = Sheets("?@作成ユニット一覧").Range("A:A").Find(What:=tx)
67 If Rng Is Nothing Then
68 MsgBox "UNIT品番が見つかりませんでした。"
69 Else
70 Worksheets("?@作成ユニット一覧").Select
71 Rng.Offset(0, 1) = "済"
72 End If
73 End With
74 Else
75 Call sakusei
76
77 End If

(超初心者) 2017/01/20(金) 08:04


 >>ナンバーを振りたくてエクセルにa列にナンバー、b列にマクロを貼りつけした所ここでは左寄せになってしまいました。

 了解です。失礼しました。 

 >>下に MsgBox c.Offset(0, 2).ValueをいれたのですがMsgBox が出てきませんでした。 

 ということは、この InStr で間違えてひっかけているのではなく、別のロジックで対象になってしまっていると思いますが?

 >>"BOARD G.,40 VSB-GL"は"MAST G*"として認識し、elseへ飛んでしまいました

 そもそもなんですが、この InStr で 結果が <>0 なら 認識した ということ(つまり対象)ですが?
 Else に飛ぶのは セル内文字列に "MAST G*" がなかった時ですから、正常ですけど?

( β) 2017/01/20(金) 08:35


β様

御回答ありがとうございました。
朝から自分でやってみようと何度も確認していますがお手上げです。

下に MsgBox c.Offset(0, 2).ValueをいれたのですがMsgBox が出てきませんでした。

と頂いたので変更して出るようにしました。

>ということは、この InStr で間違えてひっかけているのではなく、別のロジックで対象になってしまっていると思いますが?

If InStr(c.Offset(0, 2), "MAST G*") = 0 Then
に変更し、MsgBoxで出るようにしたところ、c.Offset(0, 2) の値が

MAST G.,35-40,FV30,3-4P
COMMON G.,35N-40,FV

となっているのですが、どちらも値0を返してきてしまいます。何が悪いのでしょうか?

With Sheets("チェック_入力用シート") '★参照シート

  Dim tx As String
  Dim Rng As Range
  Dim c As Range
  Dim r As Range
  Dim nxtsh As Worksheet

    tx = ActiveCell.Value

    Application.ScreenUpdating = False

    Set nxtsh = Worksheets("チェック_入力用シート").Next

    Set Rng = Sheets("チェック_入力用シート").Range("b:b").Find(What:=tx)

        For Each c In .Range(Rng, .Range("b" & Rows.Count).End(xlUp))

            With c.EntireRow

                If c <> "" Then

                    Set r = nxtsh.Columns("e:e").Find(c, LookAt:=xlWhole)

                        If c.Offset(0, 5) = "" Then

                            If c.Offset(0, 4) = "" Then

                                If InStr(c.Offset(0, 2), "MAST G*") = 0 Then
                                MsgBox InStr(c.Offset(0, 2), "MAST G*")

                                Else
                                    If r Is Nothing Then

                                     i = Worksheets("確認シート").Range("d6") + 1
                                     a = "作成_" & i
                                     c.Offset(0, 5) = a
                                     Worksheets("確認シート").Range("d6") = i

                                     Set rnga = Sheets("チェック_入力用シート").Range("g:g").Find(What:=a)

                                     Range(rnga, rnga.Offset(0, -6)).Copy

                                    Call チェックシートへ反映

                                    Else
                                    c.Offset(0, 5) = r.Offset(0, -3).Value
                            End If
                        End If
                    End If
                End If
            End If
        End With
    Next
End With
End Sub
(超初心者) 2017/01/20(金) 16:15

 Instr の "MAST G*" 、この * は ワイルドカードのつもりだったんですか?

 InStr ではワイルドカード指定ができません。"*" という文字そのものになります。
 そうすると、"MAST G.,35-40,FV30,3-4P"  この文字列内には "MAST G*" って存在しませんよね。
 だから『正しく』 0 を返しているわけです。

 MAST Gなんとか というものを抽出したい場合は Like演算子を使います。

 If c.Offset(0, 2).Value Like "*MAST G*" Then
    あった場合の処理
 Else
    なかった場合の処理
 End If

( β) 2017/01/20(金) 17:24


被りましたが…。

 > MAST G.,35-40,FV30,3-4P
 > COMMON G.,35N-40,FV

どちらの文字列にも、"MAST G*" が含まれていないので、0 になりますよ? InStr関数には、ワイルドカードは使えませんから。
"MAST G" を探すようにしてみてください。

または、ワイルドカード指定したいならば、以下のように Like文に変えましょう。

    If (c.Offset(0, 2) Like "*MAST G*") = False Then
(???) 2017/01/20(金) 17:29

β様???様

回答が遅くなり申し訳ございませんでした。

マクロが動きました。感謝感謝です。

ありがとうございました。
(超初心者) 2017/01/23(月) 07:58


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.