[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『【マクロ】分割して別ブックに保存』(もずく)
度々すいません。
ネットで似ている物を読んでいるのですが、出来なくて。。
〜A列でフィルターし分割して別ブックに保存〜
■対象ブック:CSV修正.xlsmに入力したB1 & B2のCSV
Set ws = Workbooks("CSV修正.xlsm").Sheets("Sheet1")
ws.Range("B1") & "\" & "完成" & "\" & ws.Range("B2").Value & ".csv"
■対象ブックの中身(行数も列数もいっぱいあります)
A列 B列 C列…
1行目 1 1 1
2行目 1 2 1
3行目 1 3 1
4行目 2 1 1
5行目 3 1 1
6行目 3 2 1
7行目 3 3 1
8行目 4 1 1
■保存ファイル名
ws.Range("B2")に入力した値 _ A列の数字
■保存先:対象ブックと同じ格納先
元ブックは削除して大丈夫です。
宜しくお願い致します。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
A列でフィルターするのに固有のKeyが必要なので、、 A列をディクショナリーで1回なめるか、、または、、 A列を別の場所にコピーして重複の削除でユニークなKeyにして
出来たKeyで順番にフィルターしていけばいい様に思います。。。けど?
すみません。ヒントだけで、、、 (SoulMan) 2019/03/22(金) 10:57
Dim wkSh As Worksheet Dim wkCol As Long Dim myList As Range Dim wkR As Range Dim c As Range Dim myPath As String Dim ws As Worksheet 'Dim wb As Workbooks
Application.DisplayAlerts = False Application.ScreenUpdating = False Set ws = Workbooks("CSV修正.xlsm").Sheets("Sheet1")
myPath = ws.Range("B1") & "\" & "完成" & "\" & ws.Range("B2").Value & ".csv" & "\" & ws.Range("B2").Value & ".csv" '保存フォルダ名 適切なものに変更 Worksheets.Add after:=Worksheets(Worksheets.Count) 'ブックの末尾に作業シートを Set wkSh = ActiveSheet
With Worksheets(ws.Range("B1") & "\" & Range("B2"), Range("B2").Value) 'シート名は「wsのB2に入力されている値です」★ここで今つまづいてます。 .Cells.Copy wkSh.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Set myList = .Range("A1").CurrentRegion wkCol = myList.Columns.Count + 2 'リスト領域の右、1列間をあけて作業域に 'A列から一意の値を抽出し作業列に myList.Columns(1).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Cells(1, wkCol), Unique:=True With .Cells(1, wkCol).CurrentRegion '抽出した領域全体 Set wkR = .Offset(1).Resize(.Rows.Count - 1) 'その中の項目ラベル以外 End With .Cells(1, wkCol + 1).Value = .Cells(1, wkCol).Value '検索ラベル
For Each c In wkR '抽出項目を1つずつ取り出す .Cells(2, wkCol + 1).Value = "=""" & c.Value & """" '作業用シートの値をクリア wkSh.Cells.ClearContents '作業用シートに絞り込んだデータを抽出 myList.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=.Cells(1, wkCol + 1).Resize(2), _ CopyToRange:=wkSh.Range("A1"), Unique:=False '作業用シートのみの新規ブックを作成 wkSh.Copy 'そのブックを、取り出した値をブック名にして保存 '同名のブックが存在してもワーニングなしで上書き ActiveWorkbook.SaveAs myPath & c.Value & ".xls" ActiveWorkbook.Close savechanges:=False Next
.Columns(wkCol).Resize(, 2).Clear '作業列のクリア
End With
wkSh.Delete '作業用シートの削除 Set wkR = Nothing Set myList = Nothing
Application.DisplayAlerts = True Application.ScreenUpdating = True
MsgBox "処理が終了しました"
End Sub
(もずく) 2019/03/22(金) 15:59
こんにちは。
なにをどうしようとしているのか、よくわかんないです。
CSV修正.xlsmというブックの最初のシートには、以下のデータが入っているわけですね。
A列 B列 C列… 1行目 1 1 1 2行目 1 2 1 3行目 1 3 1 4行目 2 1 1 5行目 3 1 1 6行目 3 2 1 7行目 3 3 1 8行目 4 1 1
で、 (1) CSV修正.xlsm と同じフォルダに、 (2) ws.Range("B1") という名前のサブフォルダをつくって、 (3) さらに、 "完成" という名前のサブフォルダをつくって、 (4) ws.Range("B2").Value & ".csv" という、CSVファイルを保存するのですか?
でも、このようにも書いてあります。 >■保存ファイル名 > ws.Range("B2")に入力した値 _ A列の数字
質問の内容が、最初の書き込みの中で矛盾しちゃっているので、よくわかりません。
そのCSVファイルには、どのようなデータが保存されていればいいのですか?
(でれすけ) 2019/03/22(金) 16:22
因みにCSV修正.xlsmの中はこんな感じです
■CSV修正.xlsm---------
A列 B列
格納先 C:temp
フォルダ名 1号機
出力するCSVの完成系はこちらです。
■C:temp\1号機_1.csv
A列 B列 C列… 1行目 1 1 1 2行目 1 2 1 3行目 1 3 1
■C:temp\1号機_2.csv
A列 B列 C列… 1行目 2 1 1
■C:temp\1号機_3.csv
A列 B列 C列… 1行目 3 1 1 2行目 3 2 1 3行目 3 3 1 (もずく) 2019/03/22(金) 16:54
理解しました。 以下、確認です
(1) 読み込むCSVファイルには、列タイトル行はないのでしょうか。 ないとすると、ひと手間かける必要があります。 フィルタをかける時に列タイトルを付与する。→書き込むときに列タイトルを除く
(2) A列に値は、何種類ぐらい想定されますか? 新規で書き出すCSVファイル数といってもいいです。 (3) マクロの仕様としてCSVファイルをExcelで「開く」必要ありますか。 CSVファイルをブックとして開くとか、シートに展開するとかしないでも出来るように思います。
でわ (でれすけ) 2019/03/22(金) 17:16
(2)元が4万500行ほど、列は150ほどです。
分割後は1500行ほどに
(3)開く必要はないかと思います。
(もずく) 2019/03/22(金) 17:32
(2)はユニークなA列の値は何個かって教えて欲しかったのですが。
元が45000行で1ファイル1500行くらいだと、分割後のファイルは高々 30ファイル程度と思っていいですか
(でれすけ) 2019/03/22(金) 17:38
エラー処理等やってませんので、ご了承ください。
Sub SplitCSV()
Dim CSVPath As String, BaseName As String, inFIle As Integer Dim Lbuf As String, columnTitle As String, key As String Dim outFiles As Object
'== 元ファイルの情報を取得 === With ThisWorkbook.Worksheets(1) CSVPath = .Range("B1").Value & "\" & .Range("B2").Value & ".csv" End With If Dir(CSVPath) = "" Then MsgBox CSVPath & "が見つかりません", vbCritical: Exit Sub BaseName = Split(CSVPath, "\")(UBound(Split(CSVPath, "\"))) BaseName = Left(BaseName, Len(BaseName) - 4) '== 元ファイルの情報を取得 ===
Set outFiles = CreateObject("Scripting.Dictionary")
inFIle = FreeFile Open CSVPath For Input As inFIle
Line Input #inFIle, columnTitle Do While Not EOF(inFIle) Line Input #inFIle, Lbuf key = Trim(Split(Lbuf, ",")(0)) If Not outFiles.Exists(key) Then outFiles(key) = FreeFile Open ThisWorkbook.Path & "\" & BaseName & "_" & key & ".csv" For Output As outFiles(key) Print #outFiles(key), columnTitle End If Print #outFiles(key), Lbuf Loop
Close Set outFiles = Nothing
End Sub
でわ (でれすけ) 2019/03/22(金) 18:13
あれ? 分割したCSVファルの保存フォルダがなんか違う?
その辺は、調整してください。
(でれすけ) 2019/03/22(金) 18:42
ファイル名または番号が不正と出るんですが、どこが違うのかわからないです。
Open ThisWorkbook.Path & "\" & BaseName & "_" & key & ".csv" For Output As outFiles(key)
(もずく) 2019/03/25(月) 16:17
コピペしてそのまま実行してますか? どこか修正してるなら、修正後のコードを書いてください。
それと、デバックモードになったら、ローカルウィンドウを表示させて、 変数 BaseName と Key の値が何になっているか確認して教えてください。
(でれすけ) 2019/03/25(月) 16:38
BaseName⇒B1のセルの値(こっちは問題ないと思います)
Key⇒"Serial number : 39157(VSP G1000/G1500 and VSP F1500)"
(もずく) 2019/03/25(月) 17:27
Keyは、元のCSVファイルのA列の値が入るように組んでますが、 > Key⇒"Serial number : 39157(VSP G1000/G1500 and VSP F1500)" 間違いなくA列の値がはいってますか?
それであれば、A列の値にコロン入っているが問題です。
Windowsでは、ファイル名に使えない文字というのがありまして、 詳しくは検索してください。 (でれすけ) 2019/03/25(月) 17:42
今フォルダには下記CSVがあるのですが、こちらを削除、修正したいです。
【C:temp\1号機.csv】パス(B1のセル)とフォルダ名(B2のセル)←削除
【C:temp\1号機_1.csv】←1行目とA列の削除
【C:temp\1号機_2.csv】←A列の削除
【C:temp\1号機_3.csv】←A列の削除
こんな感じと思います。
(1)【C:temp\1号機.csv】を削除
CSVPath = .Range("B1").Value & "\" & "完成" & "\" & .Range("B2").Value & ".csv"
Kill CSVPath
(2)1号機( .Range("B2").Value)で検索し
(3)末尾が_1の場合は、1行目とA列の削除
(4)末尾が_1以外の場合または2以上は、A列の削除
申し訳ございませんが宜しくお願いします。
(もずく) 2019/03/26(火) 10:24
最初からA列を書き込まなきゃいいのでは。
>末尾が_1の場合は、1行目とA列の削除 1行目って、列タイトル行のことでしょうか。 (でれすけ) 2019/03/26(火) 11:11
末尾が_1の場合は、1行目とA列の削除 1行目って、列タイトル行のことでしょうか。 ⇒すいません。間違えました。申し訳ございません。
(3)末尾が_1の場合は、A列の削除
(4)末尾が_1以外の場合または2以上は、1行目とA列の削除
末尾が_1は1行目の列タイトル行は必要でしたが、
末尾が_2からは1行目は不要です。
(もずく) 2019/03/26(火) 12:01
なんかかみ合わないな...
>分割用の採番をA列にしてるんです。 それは知っています。
分割して書き出したCSVを目視で確認してからA列を削除するのでしょうか。 目視で確認するなら、その時に手作業で削除すればいいでしょう。
目視での確認が不要なら、分割したCSVファイルを書き出す時に、 A列を書き出さないようにすればいいでしょう。
タイトル行も同じ。不要なら書き出すのを止めればいい。 (でれすけ) 2019/03/26(火) 12:10
Sub SplitCSV()
Dim CSVPath As String, BaseName As String, inFIle As Integer Dim Lbuf As String, columnTitle As String, key As String Dim outFiles As Object
'== 元ファイルの情報を取得 === With ThisWorkbook.Worksheets(1) CSVPath = .Range("B1").Value & "\" & .Range("B2").Value & ".csv" End With If Dir(CSVPath) = "" Then MsgBox CSVPath & "が見つかりません", vbCritical: Exit Sub BaseName = Split(CSVPath, "\")(UBound(Split(CSVPath, "\"))) BaseName = Left(BaseName, Len(BaseName) - 4)
Set outFiles = CreateObject("Scripting.Dictionary")
inFIle = FreeFile Open CSVPath For Input As inFIle Line Input #inFIle, columnTitle columnTitle = Mid(columnTitle, InStr(columnTitle, ",") + 1) '修正 Do While Not EOF(inFIle) Line Input #inFIle, Lbuf key = Trim(Split(Lbuf, ",")(0)) Lbuf = Mid(Lbuf, InStr(Lbuf, ",") + 1) '修正 If Not outFiles.Exists(key) Then outFiles(key) = FreeFile Open ThisWorkbook.Path & "\" & BaseName & "_" & key & ".csv" For Output As outFiles(key) If key = "1" Then Print #outFiles(key), columnTitle '修正 End If Print #outFiles(key), Lbuf Loop Close
Set outFiles = Nothing
End Sub (でれすけ) 2019/03/26(火) 12:35
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.