excel - 10,000 件までのレコードをコピーする Excel 作業を自動化し、csv ファイルに保存したい

Question

列名 (EmailID、FirstName、Checksum) を持つ 50,000 レコードの Excel ファイルがあります。そこから 10,000 レコードをコピーし、csv ファイルに保存しています。5 つの csv ファイルを手動で作成するためにこれを行います。つまり、50,000 レコードをそれぞれ 10,000 に分割します。

この作業を自動化したい。特定の場所に csv ファイルを作成するマクロを作成したいと考えています。

Answer 1

運が良ければ、データは次のようになります。

また、.CSV に手の込んだ書式設定は必要ありません。レコードセットで .GetString(, cnStep, ...) を使用し、一部の RegExp を使用して引用符を修正するだけで済む場合があります。これは、この概念実証スクリプトで例示されています。

' want-to-automate-excel-work-of-copying-records-upto-10000-each-and-save-into-csv

Option Explicit

Const adClipString = 2
Const cnStep       = 3

Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )

WScript.Quit demoMain()

Function demoMain()
  demoMain = 0 ' assume success

  Dim reClean : Set reClean = New RegExp
  reClean.Global    = True
  reClean.Multiline = True
  reClean.Pattern   = """(\d+)$"
  Dim reQuote : Set reQuote = New RegExp
  reQuote.Global    = True
  reQuote.Multiline = True
  reQuote.Pattern   = "^(.)"
  Dim sDDir   : sDDir       = "..\Data\SplitToCsv"
  Dim sXFSpec : sXFSpec     = goFS.BuildPath(sDDir, "SplitToCsv.xls")
  Dim oXDb    : Set oXDb    = CreateObject("ADODB.Connection")
  ' based on: !! http://www.connectionstrings.com/excel
  oXDb.open Join(Array(     _
        "Provider=Microsoft.Jet.OLEDB.4.0" _
      , "Data Source=" & sXFSpec           _
      , "Extended Properties="""           _
          & Join(Array(     _
                "Excel 8.0" _
              , "HDR=Yes"   _
              , "IMEX=1"    _
            ), ";" )        _
          & """"            _
  ), ";")
  Dim oRs : Set oRs = oXDb.Execute("SELECT * FROM [Everybody]")
  Dim sFs : sFs     = getRsFNames(oRs)
  Dim nR  : nR      = 1
  Do Until oRs.EOF
     Dim s : s = reQuote.Replace( _
                      reClean.Replace( _
                           oRs.GetString(adClipString, cnStep, """,""", vbCrLf) _
                         , "$1" _
                      ) _
                    , """$1" _
                 )
     Dim f : f = goFS.BuildPath(sDDir, "R" & nR & "ff.csv")
     WScript.Echo f
     WScript.Echo s
     goFS.CreateTextFile(f, True).Write sFs & vbCrLf & s
     nR = nR + cnStep
  Loop

  oXDb.Close

  WScript.Echo goFS.OpenTextFile(f).ReadAll()
End Function ' demoMain

Function getRsFNames(oRs)
  ReDim a(oRs.Fields.Count - 1)
  Dim f
  For f = 0 To UBound(a)
      a(f) = """" & oRs.Fields(f).Name & """"
  Next
  getRsFNames = Join(a, ",")
End Function ' getRsFNames

出力：

cscript 10780869.vbs
..\Data\SplitToCsv\R1ff.csv
"EM1","FN1",1
"EM2","FN2",2
"EM3","FN3",3

..\Data\SplitToCsv\R4ff.csv
"EM4","FN4",4
"EM5","FN5",5
"EM6","FN6",6

..\Data\SplitToCsv\R7ff.csv
"EM7","FN7",7

"EmailID","FirstName","Checksum"
"EM7","FN7",7

接続文字列を簡単に変更できるようにしました。インストールによっては、バージョン番号やプロパティ名を変更する必要がある場合があります。

写真の "OpenOffice" に気付くかもしれませんが、これはこのアプローチの利点の 1 つです。Excel がインストールされていないコンピューターでも機能します。

PS：質問がまだvbscriptとタグ付けされていたときに、この回答を書きました。