ここから本文です

VBSを使ってCSVファイルを操作したいです。 以下のように日付データのみが格納...

goo********さん

2019/11/1415:12:10

VBSを使ってCSVファイルを操作したいです。

以下のように日付データのみが格納されているCSVファイルがあります。

(csv1)
これをcsv2のようにヘッダーをつけて、コード(固定)、日付、日付コードを追加したいです。
日付コードは日付をみて土曜日なら002、日曜日は001,それ以外は003のような形になります。

実現可能でしょうか。
よろしくお願いいたします。

----csv1----
yyyy/mm/dd
yyyy/mm/dd
yyyy/mm/dd
.
.
.
-------------

----csv2----
コード,日付,日付コード
1000,yyyy/mm/dd,002
1000,yyyy/mm/dd,001
.
.
.
.
-------------

閲覧数:
123
回答数:
2
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

30246kikuさん

2019/11/1914:52:14

再度追加仕様があったので、再度回答し直してます

> さらにそれ以外の日を判断したいです。
> その他用のファイルを作り形式は同じで、
> 2020/01/01のような日付が記載されている場合、
> 005に変えるようなこともできますでしょうか。

祝日用ファイル:csv3.csv
他用途ファイル:csv4.csv
として、必ず存在することを前提に(各ファイルパスは変更ください)


Dim dic4, dic5, sFile1, sFile2, sA(2), sBuf, ffn2, vC, v
Const CFILE2 = "csv2.csv"
Const ForReading = 1, ForWriting = 2

Set dic4 = CreateObject("Scripting.Dictionary")
Set dic5 = CreateObject("Scripting.Dictionary")
sFile1 = "D:\HogeMoge\csv1.csv" ' ★
vC = Array( _
      Array("D:\HogeMoge\csv3.csv", "004", dic4), _
      Array("D:\HogeMoge\csv4.csv", "005", dic5) _
   )

sFile2 = Left(sFile1, InStrRev(sFile1, "\")) & CFILE2
sA(0) = "コード": sA(1) = "日付": sA(2) = "日付コード"

With CreateObject("Scripting.FileSystemObject")
   For Each v In vC
      With .OpenTextFile(v(0), ForReading)
         While (Not .AtEndOfStream)
            sBuf = .ReadLine
            If (IsDate(sBuf)) Then v(2)(CDate(sBuf)) = v(1)
         Wend
         .Close
      End With
   Next

   Set ffn2 = .OpenTextFile(sFile2, ForWriting, True)
   ffn2.WriteLine Join(sA, ",")
   sA(0) = "1000"
   With .OpenTextFile(sFile1, ForReading)
      While (Not .AtEndOfStream)
         sBuf = .ReadLine
         If (IsDate(sBuf)) Then
            sA(1) = sBuf
            Select Case Weekday(sBuf)
               Case vbSunday: sA(2) = "001"
               Case vbSaturday: sA(2) = "002"
               Case Else
                  sA(2) = "003"
                  sBuf = CDate(sBuf)
                  For Each v In Array(dic4, dic5)
                     If (v.Exists(sBuf)) Then
                        sA(2) = v(sBuf)
                        Exit For
                     End If
                  Next
            End Select
            ffn2.WriteLine Join(sA, ",")
         End If
      Wend
      .Close
   End With
   ffn2.Close
   Set ffn2 = Nothing
End With
Set dic4 = Nothing
Set dic5 = Nothing
MsgBox "完了"



以下、再回答 2019/11/18 15:18:15

追加仕様があったので、回答し直してます

> 今は土日とそれ以外で出していますが、
> たとえば別csvファイルに祝日を記載しておいて、それ以外で出した
> 「003」を「004」に変えるようなことはできますでしょうか。

> csv1.csv と同じ形式で祝日をyyyy/mm/ddで記載します。
> ----csv3----
> 2019/10/22
> 2019/11/04

> 11/3は001、11/4は004になります。
> 祝日ファイルには2019/11/04とだけ記載
> (11/3は祝日ですが日曜日なので記載しない)

変更した点は

祝日用ファイルフルパスを指定しておく(sFile3 として)※変更要
祝日を Dictionay のキーとして覚え込む
csv1.csv と 祝日ファイル内の各書式が異なっても動くように、
文字列→日付型に変更したもので覚えておく
そして、土日でなかった場合、Dictionary に覚えていたら 004 に


※ 提示している記述は、先ず、Excel の標準モジュールに記述して・・・
簡単な動作確認後、vbs ファイルとして転記して・・・・
(vbs でのデバッグは面倒なので)
なので、文字列の各スペル内の大文字・小文字は VBE が勝手に・・・
メモ帳に直に記述すると、全部小文字にしちゃうかも・・・

どうなりますか


Dim dic, sFile1, sFile2, sFile3, sA(2), sBuf, ffn2
Const CFILE2 = "csv2.csv"
Const ForReading = 1, ForWriting = 2

Set dic = CreateObject("Scripting.Dictionary")
sFile1 = "D:\HogeMoge\csv1.csv" ' ★
sFile3 = "D:\HogeMoge\csv3.csv" ' ★ 祝日用ファイル

sFile2 = Left(sFile1, InStrRev(sFile1, "\")) & CFILE2
sA(0) = "コード": sA(1) = "日付": sA(2) = "日付コード"

With CreateObject("Scripting.FileSystemObject")
   With .OpenTextFile(sFile3, ForReading)
      While (Not .AtEndOfStream)
         sBuf = .ReadLine
         If (IsDate(sBuf)) Then dic(CDate(sBuf)) = Empty
      Wend
      .Close
   End With

   Set ffn2 = .OpenTextFile(sFile2, ForWriting, True)
   ffn2.WriteLine Join(sA, ",")
   sA(0) = "1000"
   With .OpenTextFile(sFile1, ForReading)
      While (Not .AtEndOfStream)
         sBuf = .ReadLine
         If (IsDate(sBuf)) Then
            sA(1) = sBuf
            Select Case Weekday(sBuf)
               Case vbSunday: sA(2) = "001"
               Case vbSaturday: sA(2) = "002"
               Case Else
                  sA(2) = "003"
                  If (dic.Exists(CDate(sBuf))) Then sA(2) = "004"
            End Select
            ffn2.WriteLine Join(sA, ",")
         End If
      Wend
      .Close
   End With
   ffn2.Close
   Set ffn2 = Nothing
End With
Set dic = Nothing
MsgBox "完了"




以下、初期回答 2019/11/14 17:02:55


以下でどうなりますか

★ 部分のファイルフルパスを書き換えて・・・・
csv2.csv は、同じフォルダに


Dim sFile1, sFile2, sA(2), sBuf, ffn2
Const CFILE2 = "csv2.csv"
Const ForReading = 1, ForWriting = 2

sFile1 = "D:\HogeMoge\csv1.csv" ' ★

sFile2 = Left(sFile1, InStrRev(sFile1, "\")) & CFILE2
sA(0) = "コード": sA(1) = "日付": sA(2) = "日付コード"

With CreateObject("Scripting.FileSystemObject")
   Set ffn2 = .OpenTextFile(sFile2, ForWriting, True)
   ffn2.WriteLine Join(sA, ",")
   sA(0) = "1000"
   With .OpenTextFile(sFile1, ForReading)
      While (Not .AtEndOfStream)
         sBuf = .ReadLine
         If (IsDate(sBuf)) Then
            sA(1) = sBuf
            Select Case Weekday(sBuf)
               Case vbSunday: sA(2) = "001"
               Case vbSaturday: sA(2) = "002"
               Case Else: sA(2) = "003"
            End Select
            ffn2.WriteLine Join(sA, ",")
         End If
      Wend
      .Close
   End With
   ffn2.Close
   Set ffn2 = Nothing
End With
MsgBox "完了"

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜1件/1件中

Prometheusさん

2019/11/1422:20:19

プログラムファイル(「~.vbs」ファイル)に、「csv1.csv」ファイル1つだけ、ドラッグ&ドロップしてください。

ドラッグ&ドロップしたファイルが存在するフォルダ内に、結果ファイルである「csv2.csv」を作成します。

最後に「Finished!」と表示しますので、「OK」を押して、終了してください。

Option Explicit
Dim a, c, c1, c2, f, so, w, wa
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" Then
MsgBox("ドラッグ&ドロップできるのは、csvファイル1つだけです")
WScript.Quit
End If
f = so.GetParentFolderName(wa(0))
Set c1 = so.OpenTextFile(wa(0), 1)
Set c2 = so.OpenTextFile(f & "\csv2.csv", 2, True)
c2.WriteLine "コード,日付,日付コード"
Do Until c1.AtEndOfStream
a = c1.ReadLine
w = Weekday(a)
c = "003"
If w = 1 Then
c = "001"
ElseIf w = 7 Then
c = "002"
End If
c2.WriteLine "1000," & a & "," & c
Loop
c1.Close
c2.Close
Set c1 = Nothing
Set c2 = Nothing
Set so = Nothing
MsgBox("Finished!")

簡単な説明です。

Set so = CreateObject("Scripting.FileSystemObject")

「Windows」のファイルやフォルダ、テキストファイルを扱う機能を読み込んでいます。

Set wa = WScript.Arguments
If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" Then
MsgBox("ドラッグ&ドロップできるのは、csvファイル1つだけです")
WScript.Quit
End If

この部分は、ドラッグ&ドロップされるのを待っていて、ドラッグ&ドロップされると、その数や拡張子を調べ、想定外なら、メッセージを表示して、プログラムそのものを終了してしまいます。

f = so.GetParentFolderName(wa(0))

ドラッグ&ドロップされたファイルが存在するフォルダを調べています。

Set c1 = so.OpenTextFile(wa(0), 1)

ドラッグ&ドロップしたファイルを「読み込み専用」で開いています。

Set c2 = so.OpenTextFile(f & "\csv2.csv", 2, True)

同じフォルダ内に「csv2.csv」ファイルを、「書き込み専用」で新規作成しています。

c2.WriteLine "コード,日付,日付コード"

タイトル行を書き込んでいます。

Do Until c1.AtEndOfStream

ファイルの終端まで処理。

a = c1.ReadLine

1行読み込み。

w = Weekday(a)

何曜日か、数値を「w」に入れています。

詳しくは、以下のサイトをご覧ください。

https://www.kanaya440.com/contents/script/vbs/function/date/weekday...

c = "003"
If w = 1 Then
c = "001"
ElseIf w = 7 Then
c = "002"
End If

最初に「c = "003"」にしておき、あとは、「日曜日=1」なら、「c = "001"」、「土曜日=7」なら、「c = "002"」にします。

c2.WriteLine "1000," & a & "," & c

結果を書き出しています。

Loop

ファイルの終端まで繰り返して言います。

c1.Close
c2.Close
Set c1 = Nothing
Set c2 = Nothing

両ファイルを閉じています。

Set so = Nothing
MsgBox("Finished!")

あとは、終了処理で、最後に「Finished!」と表示しています。

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる