[[20191024130843]]　『新しいブックへ貼り付けとCSV変換』（１１）　ページの最後に飛ぶ

『新しいブックへ貼り付けとCSV変換』（１１）

お世話になります。

このたび、あるシステムに取り込むためにデータをCSVに変換するマクロを作成しています。

A1～EH100までを新しいワークブックに貼り付け、
新しいワークブックをCSVに変換後に指定のフォルダに保存するマクロです。

ネットで調べ、CSVファイルを作成することはできたのですが、
システムに取り込むことができませんでした。

原因は定かではありませんが（システムの開発者ではないため）、
手動でA1～EH100の範囲をコピーし、新しいワークブックに貼り付け、
CSVに変換して保存したファイルはシステムに取り込むことができました。

そのため、コピーしたデータを直接CSVに貼り付けるやり方ではなく、
新しいワークブックに貼り付けてからCSVに変換できないかと考えています。

A～K列には関数がはいっており、
K列は数字17桁（例：00123456789012345）、L列は数字8桁（00012345）
でなければシステムに取り込むことができません。

皆さんの知恵をお借りできればと思います。

よろしくお願いします。

  A     B   C   D       E         F     G   H       I         J               K               L       M    N・・・・

00000 11 A 0 20191031 123456 0 0 1.23E+14 11A00001 00111111111100001 00054321 19 10・・・・
00000 11 A 0 20191031 123456 0 0 1.23E+14 11A00001 00222222222200002 00011223 19 10・・・・
00000 11 A 0 20191031 123456 0 0 1.23E+14 11A00001 00555555555500005 00005442 19 10・・・・

今までのマクロ

Public Sub OutPutTEST()

Application.EnableEvents = False

    Dim rc As Integer
    rc = MsgBox("CSVを作成してよろしいですか?", vbYesNo + vbQuestion, "CSV作成")
    If rc = vbYes Then

    Worksheets("date").Visible = True

    Worksheets("date").Select
    Call fx_CsvOutput(Worksheets("date").Range("$A$1:$EH$100"))
    Else
    Exit Sub
    End If

Application.EnableEvents = True

End Sub

Public Function fx_CsvOutput(GetRange As Range)

    Dim OutPutFile As String
    Dim f As Integer
    Dim r As Long
    Dim c As Integer
    Dim str As String

    Application.ScreenUpdating = False

    日付 = Worksheets(3).Range("AR6")
    OutPutFile = "R:\date-a(" & 日付 & ").csv"

    f = FreeFile
    Open OutPutFile For Output As f
    For r = GetRange.row To GetRange.row + GetRange.Rows.Count - 1
        For c = GetRange.Column To GetRange.Column + GetRange.Columns.Count - 1
            If str = "" Then
                str = Cells(r, c).Text
            Else
                str = str & "," & Cells(r, c).Text
            End If
        Next c
        Print #f, str
        str = ""
    Next r

    Application.ScreenUpdating = True
    Close #f

    Worksheets("date").Visible = False
    Worksheets(3).Activate

    MsgBox "作成が完了しました。"

End Function

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

 取り込みOKのCSVファイルと取り込み不可のCSVファイルの違いは調べましたか？
 それを明らかにしないと、コードの修正もあてずっぽうになると思いますが。

 >手動でA1～EH100の範囲をコピーし、新しいワークブックに貼り付け、 
 >CSVに変換して保存したファイルはシステムに取り込むことができました。

 この作業を自動記録してみると、違ったコードが記録されますよ

（渡辺ひかる） 2019/10/24(木) 13:48

渡辺ひかるさん

取り込みOKかNGかの違いはわかりませんでしたが、
解決策が新しいワークブックに貼り付け、CSVに変換するやり方でした。

マクロの記録をしてみたのですが、
K列、L列の桁がうまくいきませんでした。

Sub Macro2()

    Workbooks.Add
    Windows("取り込み.xlsm").Activate
    Range("A1:EH100").Select
    Selection.Copy
    Windows("Book1").Activate
    ActiveSheet.Paste
    Range("A1:J5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K1:K5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L2").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="D:\Book1.csv", _
        FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWindow.Close

   End sub
（１１） 2019/10/24(木) 14:11

 ＞K列、L列の桁がうまくいきませんでした。

 おそらく新規シートの書式が「標準」なので、K列、J列が　指数表示になっているのではないかと思います。

 以下の手順でもう一度自動記録してみてください

 1.新規ブックを追加
 2.新規ブックのシートの貼り付け先のセルの書式をすべて文字列とする
 3.コピー元からコピーして、コピー先へ値のみ貼り付け
 4.新規ブックをCSVで形式で保存

（渡辺ひかる） 2019/10/25(金) 09:35

コメント返信：

[ 一覧(最新更新順) ]

[[20191024130843]] 『新しいブックへ貼り付けとCSV変換』（１１） ページの最後に飛ぶ

[[20191024130843]]　『新しいブックへ貼り付けとCSV変換』（１１）　ページの最後に飛ぶ