Home
Blog
Inquire
ＶＢＡ

ＶＢＡ--- エクセル：ＣＳＶファイルのデータをシートに貼り付け


　会計ソフトよりエクスポートした仕訳データ(ＣＳＶ形式)をエクセルのシートに貼り付け（説明は省略）

 Sub Shiwaecsv()
  Dim vfl,vstream1,vtmp As String
  Dim adoobj As Object
  Dim ,vcsv1,vcsv2,rowcnt As Long
  vfl = "C:\ShiwakeData.csv"
  Set adoobj = CreateObject("ADODB.Stream")
  adoobj.Chare = "UTF-8"
  adoobj.Open
  adoobj.LoadFromFile vfl
  vstream1 = adoobj.ReadText
  rowcnt = 1
   For vcsv1 = 0 To UBound(Split(vstream1,vbLf))
    vtmp = Replace(Split(vstream1,vbLf)(vcsv2),Chr(34),"")
    For vcsv2 = 0 To UBound(Split(vtmp,","))
     If rowcnt > 1 Then
      Select Case vcsv2
       Case 0
        Worksheets("仕訳帳").Cells(rowcnt,vcsv2 + 1) = Format(Val(Split(vtmp,",")(vcsv2)),"###")
       Case 1
        Worksheets("仕訳帳").Cells(rowcnt,vcsv2 + 1) = _
         Format(DateSerial(Val(Mid(Split(vtmp,",")(vcsv2),1,4)),Val(Mid(Split(vtmp,",")(vcsv2),6,2)), _
          Val(Mid(Split(vtmp,",")(vcsv2),9,2))),"yyyy/mm/dd")
       Case 3,9
        Worksheets("仕訳帳").Cells(rowcnt,vcsv2 + 1) = _
         Format(Val(Split(vtmp,",")(vcsv2)),"#,###")
       Case Else
        Worksheets("仕訳帳").Cells(rowcnt,vcsv2 + 1) = Split(vtmp,",")(vcsv2)
      End Select
     Else
      If vcsv2 = 0 then
       Worksheets("仕訳帳").Range("A1") = "通番"
      Else
       Worksheets("仕訳帳").Cells(rowcnt,vcsv2 + 1) = Split(vtmp,",")(vcsv2)
      End If
     End If
    Next vcsv2
    vtmp = adoobj.ReadText(-2)
    rowcnt = rowcnt + 1
   Next vcsv1
  adoobj.Close
  MsgBox "End!"
 Exit Sub

©2018KanazawaNoSakai