- ベストアンサー
ExcelマクロでCSV出力する方法
- Excelマクロを使用して、指定のデータをCSV形式で出力する方法について説明します。
- マクロでは、「データ」シートのA3からO列の最終行までのデータを取得し、指定のパスにCSVファイルとして出力します。
- また、A列が空白である行は無視され、出力されないようにするロジックの追加方法も説明します。
- 148289
- お礼率50% (3/6)
- Visual Basic
- 回答数4
- ありがとう数2
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (3)
- kmetu
- ベストアンサー率41% (562/1346)
- kmetu
- ベストアンサー率41% (562/1346)
- imogasi
- ベストアンサー率27% (4737/17068)
Print ＃の塊をまたぐ形で、 For intRow ・・・ If セルが空白でなければ Print #1、・・・ End If Next intRow とするだけでは？ 質問のコードはどこかを引き写したのかな。 質問のコード内容と釣り合わない質問だな。 １－１５列まで途切れないらしいから For j=1 to 15 s=s & Cells(i,j) & "," Next j s=Left(s,Len(s)-1) とネストすれば、読み易くなるのでは。 一々各列を羅列するのは稚拙。 intRowもiにした。
お礼
ご回答ありがとうございました。 全くの初心者で、他のコードを参考に作ったものでして。 一から勉強が必要ですね。
関連するQ&A
- ＥｘｃｅｌマクロCSV出力 行に連番をつける
Private Sub CommandButton1_Click() ' 実行したPCのDドライブに保存 Open "D:\data1.csv" For Output Access Write As #1 ' データシートのB17からB列にデータが入っている行のみを出力 ' もしB列にデータがあり、値が「ああ」なら区分を「1」に「いい」なら「2」に置き換える With Sheets("データ") Print #1, "区分" & "," & "ID" & "," & "名前" For intRow = 17 To .Range("B" & Rows.count).End(xlUp).Row If Trim(.Cells(intRow, 2).Value) <> "" And .Cells(intRow, 2).Value = "ああ" Then Print #1, Replace(.Cells(intRow, 2), "ああ", "1") & "," & Trim(.Cells(intRow, 3)) & "," & Trim(.Cells(intRow, 4)) ElseIf Trim(.Cells(intRow, 2).Value) <> "" And .Cells(intRow, 2).Value = "いい" Then Print #1, Replace(.Cells(intRow, 2), "いい", "2") & "," & Trim(.Cells(intRow, 3)) & "," & Trim(.Cells(intRow, 4)) End If Next intRow End With Close #1 End Sub ------------------------------------------------------------- 上記のロジックで「データ」シートのB17からD列の最終行までをCSV出力しています。 その際、(1)B列に値が入った行のみを出力する(A列が空白なら無視し次の行へ) (2)B列の値が「ああ」ならCSVファイルで「1」に、「いい」なら「2」に置き換え というロジックを加えています。 このコードに、CSV出力時の最終項目（名前の後ろ）に連番を項目として追加する ロジックを追加したいのですが、方法がわかる方いらっしゃいますか？ CSVファイルは下記のようなイメージです。 区分,ID,名前,連番 1,9999,太郎,1 2,8888,花子,2 1,7777,一郎,3 1,6666,次郎,4 どなたか教えてくださいm(__)m！！
- ベストアンサー
- Visual Basic
- エクセル 全通り出力
Sub test01() a = Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行取得 b = Cells(Rows.Count, "B").End(xlUp).Row 'B列最終行取得 For i = 1 To a '１行からA列最終行まで繰り返し For n = 1 To b '１行からB列最終行まで繰り返し x = x + 1 Cells(x, "C") = Cells(i, "A") & " " & Cells(n, "B") 'C列に結合して転記 Next n Next i End Sub こちら過去の解答にあったのですが、ａ，ｂ，ｃ，ｄに数字が入っていて、 Ｅに組み合わせを出力する場合どう変えればよいのでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロについて
下記は、A列3行の7文字目～10文字と B列5行～文字のある最後の行までの範囲の左から1文字目～4文字 に相違がある場合 MsgBox i ＆ “行目” を出す。 というマクロなのですが、『B列5行～文字のある最後の行までの範囲』の中でも『空白のセルに関してはMsgBox不要』というふうに付加えたいのですがどのようにすればよいでしょうか。 Sub Macro1() Dim i As Long Dim sOrgText As String Dim ltotal As Long With ActiveSheet sOrgText = Mid(.Cells(3, 1), 7, 4) ltotal = .Cells(65536, 2).End(xlUp).Row For i = 5 To ltotal If Not Mid(.Cells(i, 2), 1, 4) = sOrgText Then MsgBox i & "行目" End If Next i End With End Sub
- ベストアンサー
- SE・インフラ・Webエンジニア
- マクロCSV出力
Sheet1に入力されている値をCSVファイルに出力したいと思っております。 但し、特定のセルだけを取得して、１つのファイルに出力したいと思っています。 (1)D2～G2に入力されている値を取得 (2)E4～E10までと、E4～E10の最終列までの値を取得 (3)B11の値を取得 (4)A13～A列の最終行まで、A13～A列の最終行の最終列までの値を取得 (1)、(2)、(3)、(4)の値を取得して、１つのCSVファイルに出力するプログラムを作成したいと思っております。 (1)は１行目に出力 (2)は２行目～８行目に出力 (3)は９行目に出力 (4)は１０行目以降に出力 出力の形式は ”TEST”,” ”,”SMP”のようにダブルクォーテーションで値を囲って出力したいと思っています。 値が入っていないセルは” ”,としたいと思っております。 サンプルを作成して頂けないでしょうか。
- 締切済み
- Visual Basic
- シートAとシートBの得意先コードが一致したら、該当行をシートCにコピー
シートAとシートBの得意先コードが一致したら、該当行をシートCにコピーするVBAを組みたいのですが、上手く行きません。加えてシートＡの該当行は削除しておきたいです。 ＸＰでExcel2003を使用しています。 Const strMasSheet = "A" Const strMasSheet2 = "B" Const strSrhSheet = "C" Dim strSrhCode As Long 'シートAの得意先コード Dim strSrhCode2 As Long 'シートBの得意先コード Dim intRow As Long Dim intRow2 As Long Dim intCnt As Long Dim maxgyo As Long 'シートAの最終行 Dim maxgyo2 As Long 'シートBの最終行 Sub データを分ける() maxgyo = Sheets(strMasSheet).Cells(Rows.Count, 1).End(xlUp).Row 'シートAの最終行を取得 For intRow = 2 To maxgyo '2行から始めて最終行まで（1upで） strSrhCode = Sheets(strMasSheet).Cells(intRow, 2) '検索値 B列= 得意先ＣＤを取得 maxgyo2 = Sheets(strMasSheet2).Cells(Rows.Count, 1).End(xlUp).Row 'シートBの最終行を取得 For intRow2 = 2 To maxgyo '2行から始めて最終行まで（1upで） strSrhCode2 = Sheets(strMasSheet).Cells(intRow, 8) '検索値 H列 = 得意先ＣＤを取得 intCnt = 2 '2行から If strSrhCode = strSrhCode2 Then 'もし検索値と検索対象シートの得意先ＣＤが一致したら intCnt = intCnt + 1 With Sheets(strSrhSheet) .Cells(intCnt, 1) = Cells(intRow, 1) .Cells(intCnt, 2) = Cells(intRow, 2) .Cells(intCnt, 3) = Cells(intRow, 3) .Cells(intCnt, 4) = Cells(intRow, 4) .Cells(intCnt, 5) = Cells(intRow, 5) .Cells(intCnt, 6) = Cells(intRow, 6) .Cells(intCnt, 7) = Cells(intRow, 7) .Cells(intCnt, 8) = Cells(intRow, 8) .Cells(intCnt, 9) = Cells(intRow, 9) .Cells(intCnt, 10) = Cells(intRow, 10) .Cells(intCnt, 11) = Cells(intRow, 11) End With End If Next intRow2 Next intRow MsgBox "処理終了" End Sub 言葉足らずの所があればごめんなさい。 追記いたしますので、教えて下さい。 よろしくお願い致します。
- ベストアンサー
- その他MS Office製品
- エクセルのマクロについて
Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア～ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか？できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub
- 締切済み
- オフィス系ソフト
- マクロでhtml出力？
先日、マクロの件で質問した者です。 http://oshiete1.goo.ne.jp/qa4473686.html 良回答のlulさんのコードを参考にしています。 質問１ 下記のコードではV列にhtmlが表示されるようになっています。 （エクセルにはAからTまでデータが入っています） 今回はセルV列にhtmlを表示するのではなくエクセルシートが置いてあるフォルダに各htmlを出力したいのですがどこをどのように変更すればいいのでしょうか？ （ちなみに、C列にあるものをファイル名とします） 質問２ また、フォルダ名を指定してそのフォルダに出力する場合も教えてください。 よろしくお願いします。 Sub htmlを作成() Const LFeed As String = vbCrLf Dim st As String Dim sht As Worksheet, i As Long, obj Set sht = ActiveSheet '//現在のシートを設定 Dim MaxRow As Long MaxRow = Range("A65536").End(xlUp).Row For i = 1 To MaxRow If Cells(i, 1) <> "" Then Set Grammar = Nothing 'HTML1行ずつ記載 st = "" st = st & "<html lang='ja'>" & LFeed st = st & "<head>" & LFeed st = st & "</head>" & LFeed st = st & "<body>" & LFeed 途中省略 st = st & "</body>" & LFeed st = st & "</html>" & LFeed st = Replace(st, "'", Chr(34), 1, -1, 1) sht.Cells(i, 22).Value = Mid(st, 1, Len(st) - 1) '//結果を V列に入れる（他の場合はそのように変更する） End If Next i End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロでプログラムを作りたいのですが教えてください
まず一行目に４８列のデータがあり、 2行目から32行目までにも同様に４８列のデータがあります。 条件が1800以上の数値ならその列の1行めのデータを50行目に縦一列にどんどん出力させるというプログラムをつくりたいのです。 条件が偽の場合は空欄です。 下に途中まで努力したのですがどこをなおせばいいのかわかりません。 分かるかたいましたらご指摘お願いいたします。 Sub Macro1() Dim n As Integer For n = 1 To 31 Sheet1.Cells(n + 1, 50) = "=IF(Cells(n+1, 1)> 1800,A1,"""")" Sheet1.Cells(n + 31 * 1 + 1, 50) = "=IF(Cells(n+1, 2)> 1800,B1,"""")" Sheet1.Cells(n + 31 * 2 + 1, 50) = "=IF(Cells(n+1, 3)> 1800,C1,"""")" ・ ・ ・ ・ ・ Sheet1.Cells(n + 31 * 47 + 1, 50) = "=IF(Cells(n+1,48)> 1800,AV1,"""")" Next End Sub 宜しくお願い致します。
- 締切済み
- Visual Basic
- エクセル マクロ 教えてください。
sheet１に （a1=No. b1=月日 C1=項目 d1=収入 e1=支出 f1=摘要 G1=店名）項目を作りそれらをユーザーフォームを作り入力したいです。 この記述では上手く動けません。教えてください。 Private Sub CommandButton1_Click() Dim r As Long, 最終行 As Long, 項目行 As Long Dim re As String r = textboxs1.Value + 10 最終行 = Worksheets("入力").Range("B65536").End(xlUp).Row If r <= 最終行 Then re = MsgBox("訂正" & " " & "すでにデータが入力されています。" & Chr(13) & _ Chr(13) & "データを置き換えます。 本当に良いですか? ", _ Buttons:=vbYesNo + vbExclamation, Title:="注意!!") If re = vbYes Then With Worksheets("入力") .Cells(r, 2).Activate .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = ComboBox2.Value End With データクリア Exit Sub End If データクリア Exit Sub End If If r >= 最終行 + 1 Then r = 最終行 + 1 End If With Worksheets("入力") .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = CBomboox2.Value End With データクリア End Sub r = データNo + 10 With Worksheets("入力") .Activate .Cells(r, 2).Select TBox1.Value = .Cells(r, 1).Value TBox2.Value = .Cells(r, 2).Value ComboBox1.Value = .Cells(r, 3).Value TBox3.Value = Format(.Cells(r, 4).Value, "###,###") TBox4.Value = Format(.Cells(r, 5).Value, "###,###") TBox5.Value = .Cells(r, 6).Value ComboBox2.Value = .Cells(r, 7).Value End With Exit Sub End If If データNo > 最終行 - 10 Then データNo = 最終行 - 9 TBoxNo.Value = データNo データクリア End If End Sub
- ベストアンサー
- オフィス系ソフト
- 【VBA】ExcelマクロでCSVファイルに保存したデータが""で囲まれてしまう
添付図のような、Excel2003で作成した表内のデータを CSVで保存するマクロを作成したのですが、 図のように、CSVファイルに「""」で値が囲まれた状態で、 保存されてしまいます。 下記にマクロを記載しますので、 どうすれば文字列が「""」で囲まれずに、 カンマ区切りだけのデータで出力されるのか、 ご存知の方おられましたら、ご教示お願い致します。 Sub csv保存() Dim フォルダ名 As String Dim パス名 As String Dim ファイル名 As String Dim データ As Variant Dim 行数 As Long, 列数 As Integer Dim i As Integer, j As Long, k As Long ファイル名 = "test.csv" フォルダ名 = "csv" パス名 = ActiveWorkbook.Path & "\" & _ フォルダ名 'csvフォルダが存在しなければ作成する If Dir(パス名, vbDirectory) = "" Then MkDir パス名 End If ChDir パス名 Open ファイル名 For Output As #1 For i = 1 To Worksheets.Count Worksheets(i).Activate Worksheets(i).Cells(1, 1).Select ActiveCell.CurrentRegion.Select 行数 = Selection.Rows.Count 列数 = Selection.Columns.Count For j = 1 To 行数 For k = 1 To 列数 - 1 データ = Selection.Cells(j, k) _ .Value Write #1, データ; Next k Write #1, Selection.Cells(j, 列数) _ .Value Next j Next i Close #1 End Sub
- ベストアンサー
- Visual Basic
お礼
Excelのバージョンの問題ではありませんでした。 ご回答を参考にマクロを完成させることができました。 本当にありがとうございました。
補足
ご回答ありがとうございます。 教えていただいたとおりに変更してみたのですが、 実行時エラー'1004'; アプリケーション定義またはオブジェクト定義のエラーです。 というエラーメッセージが出てしまいます。 ちなみにExcel2000で実行していますが、問題ありますでしょうか？