ここから本文です

VBSで、指定のカラムの値が23:59:59のとき、別のカラムの値を0:00:00にしたい

aam********さん

2019/5/1516:35:04

VBSで、指定のカラムの値が23:59:59のとき、別のカラムの値を0:00:00にしたい

VBSで指定のカラムの値に[23:59:59]が指定されていた場合に、別カラムの値を[0:00:00]にしたいと考えています

変更条件:
①OFF1の値が[23:59:59]の時、同じ[u_no]の翌日のON1の値を[0:00:00]にしたい
(2019/5/7,,8:32:00,23:59:59,15,8:06:56 → 2019/5/8,AAA,0:00:00,17:12:00,15,7:25:27
⇒ u_no15の5/7のOFFが[23:59:59]なので、u_no15の5/8のONの値を[0:00:00])

②OFF1の値が[23:59:59]であっても、翌日のレコードがなければ[0:00:00]を入れない
(2019/5/12,,8:30:00,23:59:59,19,11:43:57 → 2019/5/14,CCC,8:38:00,11:26:00,19,2:14:36
5/13のレコードがないので、どこも[]に設定しない)


元csv:csv_tmp1.csv
日付,表示名,ON1,OFF1,u_no,act_time
2019/5/14,AAA,8:29:00,8:30:00,15,0:01:00
2019/5/14,BBB,8:49:00,8:51:00,18,0:01:00
2019/5/14,CCC,8:38:00,11:26:00,19,2:14:36
2019/5/13,,8:28:00,17:04:00,15,7:33:15
2019/5/13,,8:49:00,17:58:00,18,7:54:07
2019/5/13,CCC,8:36:00,19:21:00,19,8:05:25
2019/5/12,,8:31:00,17:04:00,15,7:34:01
2019/5/12,,8:48:00,18:40:00,18,8:50:37
2019/5/12,,8:30:00,23:59:59,19,11:43:57
2019/5/9,,8:51:00,19:10:00,18,8:23:09
2019/5/9,,8:52:00,23:28:00,19,10:33:02
2019/5/8,AAA,8:25:00,17:12:00,15,7:25:27
2019/5/8,,8:48:00,18:46:00,18,7:50:56
2019/5/8,,8:48:00,22:49:00,19,11:43:39
2019/5/7,,8:32:00,23:59:59,15,8:06:56
2019/5/7,,9:01:00,18:13:00,18,6:33:28



変更後csv:csv_tmp2.csv
日付,表示名,ON1,OFF1,u_no,act_time
2019/5/14,AAA,8:29:00,8:30:00,15,0:01:00
2019/5/14,BBB,8:49:00,8:51:00,18,0:01:00
2019/5/14,CCC,8:38:00,11:26:00,19,2:14:36
2019/5/13,,8:28:00,17:04:00,15,7:33:15
2019/5/13,,8:49:00,17:58:00,18,7:54:07
2019/5/13,CCC,8:36:00,19:21:00,19,8:05:25
2019/5/12,,8:31:00,17:04:00,15,7:34:01
2019/5/12,,8:48:00,18:40:00,18,8:50:37
2019/5/12,,8:30:00,23:59:59,19,11:43:57
2019/5/9,,8:51:00,19:10:00,18,8:23:09
2019/5/9,,8:52:00,23:28:00,19,10:33:02
2019/5/8,AAA,0:00:00,17:12:00,15,7:25:27
2019/5/8,,8:48:00,18:46:00,18,7:50:56
2019/5/8,,8:48:00,22:49:00,19,11:43:39
2019/5/7,,8:32:00,23:59:59,15,8:06:56
2019/5/7,,9:01:00,18:13:00,18,6:33:28


コードは以下で確認しましたが、
どちらもうまくいきませんでした
コード1:
Dim dic, fw, sA, dt , sd,ckck5,ckck6
Const CPATH = "C:\csvtest\"
Const CINFILE = "csv_tmp1.csv", COUTFILE = "csv_tmp2.csv"
Const ForReading = 1, ForWriting = 2

Set dic = CreateObject("Scripting.Dictionary")

With CreateObject("Scripting.FileSystemObject")
Set fw = .OpenTextFile(CPATH & COUTFILE, ForWriting, True)
With .OpenTextFile(CPATH & CINFILE, ForReading)
If (Not .AtEndOfStream) Then fw.WriteLine .ReadLine
While (Not .AtEndOfStream)
sA = Split(.ReadLine, ",")
If (UBound(sA) = 5) Then

sd =sA(0)
ckck5 = replace(sd,"""","")
'msgbox ckck5
ckck6 = sA(3)
'msgbox ckck6
'dt = CDate(sA(0))
dt = CDate(ckck5)
If (dic.Exists(sA(4))) Then
If (dic(sA(4)) = dt) Then
sA(2) = "0:00:00"
dic.Remove sA(4)
ElseIf (sA(3) = "23:59:59") Then
dic(sA(4)) = dt + 1
End If
ElseIf (sA(3) = "23:59:59") Then
dic(sA(4)) = dt + 1
End If
fw.WriteLine Join(sA, ",")
End If
Wend
.Close
End With
fw.Close
End With
Set dic = Nothing

このコードでは、[0:00:00]へ変換されません

コード2:
Dim a, c, co, cr, d(), f, m, n, i, j, so, x, z(5),ckck2,ckck1
Set so = CreateObject("Scripting.FileSystemObject")
f = so.GetParentFolderName(WScript.ScriptFullName)
Set co = so.OpenTextFile(f & "\csv_tmp1.csv", 1)
Set cr = so.OpenTextFile(f & "\csv_tmp2.csv", 2, True)
x = co.ReadLine
cr.WriteLine x
c = - 1
Do Until co.AtEndOfStream
a = Split(co.ReadLine, ",")
c = c + 1
ReDim Preserve d(5, c)
For i = 0 to 5
d(i, c) = a(i)
Next
Loop
co.Close
Set co = Nothing
For i = 0 to c
ckck1=d(3, i)
msgbox ckck1

If d(3, i) = "23:59:59" Then
m = i
n = DateAdd("d", 1, d(0, i))
End If
For j = m + 1 to c

'msgbox m
ckck2=(d(0, j))
msgbox ckck2
msgbox n

If n = DateValue(d(0, j)) and d(3, j) = "23:59:59" and d(4, j) = d(4, i) Then

msgbox n

d(2, j) = "0:00:00"
Exit For
End If
Next
Next
For i = 0 to c
For j = 0 to 5
z(j) = d(j, i)
Next
cr.WriteLine Join(z, ",")
Next
cr.Close
Set cr = Nothing
Set so = Nothing
'MsgBox("Finished!")

このコードでは、同日のONが[0:00:00]になります


すいません。
修正内容のご教授をお願いいたします

補足コード2では、
If n = DateValue(d(0, j)) and d(3, j) = "23:59:59" and d(4, j) = d(4, i) Then

If and d(3, j) = "23:59:59" and d(4, j) = d(4, i) Then
で実施していました
(おそらくここが翌日をしている箇所ですが、この=条件が合わなくでうまくいかないようです)

閲覧数:
42
回答数:
2
お礼:
50枚

違反報告

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

kik********さん

2019/5/1609:14:15

雰囲気、以下でどうなりますか

まだ登場されてないですね
※ お気に入りの方がいるのなら、リクエストされては??
それッポク動く?記述の提示あると思いますよ


Dim dic, dicW, sA, sH, dt, vK, v
Const CPATH = "C:\csvtest\"
Const CINFILE = "csv_tmp1.csv", COUTFILE = "csv_tmp2.csv"
Const ForReading = 1, ForWriting = 2

Set dic = CreateObject("Scripting.Dictionary")

With CreateObject("Scripting.FileSystemObject")
   With .OpenTextFile(CPATH & CINFILE, ForReading)
      If (Not .AtEndOfStream) Then sH = .ReadLine
      While (Not .AtEndOfStream)
         sA = Split(.ReadLine, ",")
         If (UBound(sA) = 5) Then
            dt = CDate(sA(0))
            If (Not dic.Exists(dt)) Then
               dic.Add dt, CreateObject("Scripting.Dictionary")
            End If
            Set dicW = dic(dt)
            dicW(sA(4)) = sA
            If (sA(3) = "23:59:59") Then
               dt = dt + 1
               If (dic.Exists(dt)) Then
                  Set dicW = dic(dt)
                  If (dicW.Exists(sA(4))) Then
                     v = dicW(sA(4))
                     v(2) = "0:00:00"
                     dicW(sA(4)) = v
                  End If
               End If
            End If
         End If
      Wend
      .Close
   End With

   If (dic.Count > 0) Then
      With .OpenTextFile(CPATH & COUTFILE, ForWriting, True)
         .WriteLine sH
         For Each vK In dic.Keys
            Set dicW = dic(vK)
            For Each v In dicW.Items
               .WriteLine Join(v, ",")
            Next
         Next
         .Close
      End With
   End If
End With
Set dic = Nothing
Set dicW = Nothing
MsgBox "完了"

  • kik********さん

    2019/5/1611:16:52

    余談


    今回のサンプルファイルの内容
    , (カンマ)は正常にあるようですね

    過去質問

    https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q122062295...
    では、, 無い部分があって動作確認に手惑いましたが

    今回は、

    > 5/13のレコードがないので、どこも[]に設定しない)

    u_no 19 の 5/13 のデータは存在しますね
    提示してみた処理では、
    2019/5/13,CCC,8:36:00,19:21:00,19,8:05:25

    2019/5/13,CCC,0:00:00,19:21:00,19,8:05:25
    に、書き変わります
    ちなみに、書き変わるところは、他1か所
    2019/5/8,AAA,0:00:00,17:12:00,15,7:25:27

  • その他の返信(1件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2019/5/17 08:47:29

ありがとうございます。
こちらを参考に実装してみます

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

1〜1件/1件中

プロフィール画像

カテゴリマスター

hot********さん

2019/5/1600:42:29

>②OFF1の値が[23:59:59]であっても、翌日のレコードがなければ[0:00:00]を入れない
>(2019/5/12,,8:30:00,23:59:59,19,11:43:57 → >2019/5/14,CCC,8:38:00,11:26:00,19,2:14:36
>5/13のレコードがないので、どこも[]に設定しない

2019/5/13 CCC 8:36:00 19:21:00 19 8:05:25

は、2019/5/12のu_no=19に対応する変更対象ではないのでしょうか?
ちなみにこれが対象の場合です。

修正でなくDictionaryを使って2パスで処理する方法です。
"C:\sample\csv_tmp1.csv" を"C:\sample\csv_tmp2.csv" に出力します。



Dim inFile
Dim outFile
inFile = "C:\sample\csv_tmp1.csv" '読み込むcsv
outFile = "C:\sample\csv_tmp2.csv" '書き込むcsv
Const ForReading = 1
Const ForWriting = 2
Dim fso
Dim f
Dim l
Dim dic
Dim i
Dim d
Set fso = CreateObject("Scripting.FileSystemObject") 'fso
Set dic = CreateObject("Scripting.Dictionary") 'Dictionaryオブジェクト
'読込
Set f = fso.OpenTextFile(inFile) 'csvファイルを開く
l = Split(f.ReadAll, vbCrLf) '改行で区切って配列に読み込む
f.Close '閉じる
'チェック(対象日とu_noのペアを取得)
For i = 1 To UBound(l) '配列を2番目から順に
d = Split(l(i), ",") 'カンマで区切って配列に読み込む
If UBound(d) >= 4 Then 'カンマ区切りで5カラム以上なら
If d(3) = "23:59:59" Then
dic.Add DateValue(d(0)) + 1 & Chr(0) & d(4), "" '4カラム目(OFF1)が"23:59:59"ならDictionaryに1カラム目の翌日とu=noをキーとして登録(chr(0)で繋ぐ)
End If
End If
Next
'書き換え
For i = 1 To UBound(l) '配列を2番目から順に
d = Split(l(i), ",") 'カンマで区切って配列に読み込む
If UBound(d) >= 4 Then 'カンマ区切りで5カラム以上なら
If dic.Exists(DateValue(d(0)) & Chr(0) & d(4)) Then '日付とu_noが対象なら
d(2) = "0:00:00" '3カラム目を"0:00:00"
l(i) = Join(d, ",") '絡む方向の配列をカンマで繋いで行方向の配列へ
End If
End If
Next
'書出
Set f = fso.OpenTextFile(outFile, ForWriting, True)
f.write Join(l, vbCrLf)
f.Close '閉じる

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

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

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

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

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

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

閉じる

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

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

閉じる