解決済み

vbs データ登録用にcsvを編集

  • 暇なときにでも
  • 質問No.9564682
  • 閲覧数142
  • ありがとう数1
  • 気になる数0
  • 回答数2
  • コメント数0

お礼率 18% (129/690)

vbsで以下のように編集したいです。
よろしければコードのご教示宜しくお願い致します。
<編集前>
   A     B      C     D
1 #氏名   メアド1   メアド2  メアド3...........メアド10
2 田中太郎 aaa@aaa.jp 
3 田中太郎 bbb@bbb.jp ccc@ccc.jp
4 田中太郎 aaa@aaa.jp       ddd@ddd.jp

<編集後>
   A     B      C     D     E
1 #氏名   メアド1   メアド2   メアド3  メアド4........メアド10
2 田中太郎 aaa@aaa.jp bbb@bbb.jp ccc@ccc.jp ddd@ddd.jp

<編集内容>
・氏名をキーに同一の氏名があった場合に、一行にメアドをまとめる。
・一行に表示するメアド数の上限は、10個(メアド10)として、それ以上は削除
・メアドが被った場合は、置換する。(B列のaaa@aaa.jpを指す)
・メアド10まで埋まらなかった場合は、メアド10(K列)まで","(カンマ)を一つのセルごとに出力する。

説明が下手ですみません。
条件不足等ございましたらお知らせください。

質問者が選んだベストアンサー

  • 回答No.2

ベストアンサー率 61% (396/641)

Visual Basic カテゴリマスター
一行目の項目名を忘れていました。
Option Explicit
Dim a, cr, cv, f, i, j, k, n, wa, so, x, buf, myDic, d, str, v, v2(10), L
Set so = CreateObject("Scripting.FileSystemObject")
Set myDic = CreateObject("Scripting.Dictionary")
Set wa = WScript.Arguments
For i = 0 to wa.Count - 1
If LCase(so.GetExtensionName(wa(i))) = "csv" Then
f = so.GetParentFolderName(wa(i))
n = so.GetBaseName(wa(i))
With so.OpenTextFile(wa(i), 1)
' .SkipLine
buf = .ReadAll
.Close
End With
buf = Split(buf, vbCrLf)
For j = 1 to UBound(buf)
a = Split(buf(j), ",")
If UBound(a) > 0 Then
If Not myDic.Exists(a(0)) Then myDic.Add a(0), Empty
For k = 1 to UBound(a)
If myDic(a(0)) = "" Then
myDic(a(0)) = a(k)
Else
If a(k) <> "" and InStr(myDic(a(0)), a(k)) = 0 Then
myDic(a(0))= myDic(a(0)) & "," & a(k)
End if
End If
NeXt
End If
Next
Set cr = so.OpenTextFile(f & "\" & n & "(Result).csv", 2, True)
cr.WriteLine buf(0)
For Each d In myDic.keys
str = myDic(d) & String(9, ",")
v = Split(str, ",")
v2(0) = d
For L = 1 to 10
v2(L) = v(L-1)
Next
cr.WriteLine Join(v2, ",")
Next
cr.Close
myDic.RemoveAll
End If
Next
Set cv = Nothing
Set cr = Nothing
Set wa = Nothing
Set so = Nothing
Set myDic = Nothing
MsgBox("Finished!")
補足コメント
tyarutiru

お礼率 18% (129/690)

ご回答ありがとうございます。
差し支えなければ、一行一行のコードの説明を加えていただけないでしょうか。
難しいようであれば結構です。
投稿日時 - 2018-12-10 14:11:56
お礼コメント
tyarutiru

お礼率 18% (129/690)

ご回答ありがとうございました。
自身で整理し理解を深めようと思います。
投稿日時 - 2018-12-11 21:18:21
感謝経済

その他の回答 (全1件)

  • 回答No.1

ベストアンサー率 61% (396/641)

Visual Basic カテゴリマスター
レスがつかないですね
Prome_Lin さんのコードを無断使用しました。
お試しください。
Option Explicit
Dim a, cr, cv, f, i, j, k, n, wa, so, x, buf, myDic, d, str, v, v2(10), L
Set so = CreateObject("Scripting.FileSystemObject")
Set myDic = CreateObject("Scripting.Dictionary")
Set wa = WScript.Arguments
For i = 0 to wa.Count - 1
If LCase(so.GetExtensionName(wa(i))) = "csv" Then
f = so.GetParentFolderName(wa(i))
n = so.GetBaseName(wa(i))
With so.OpenTextFile(wa(i), 1)
.SkipLine
buf = .ReadAll
.Close
End With
buf = Split(buf, vbCrLf)
For j = 0 to UBound(buf)
a = Split(buf(j), ",")
If UBound(a) > 0 Then
If Not myDic.Exists(a(0)) Then myDic.Add a(0), Empty
For k = 1 to UBound(a)
If myDic(a(0)) = "" Then
myDic(a(0)) = a(k)
Else
If a(k) <> "" and InStr(myDic(a(0)), a(k)) = 0 Then
myDic(a(0))= myDic(a(0)) & "," & a(k)
End if
End If
NeXt
End If
Next
Set cr = so.OpenTextFile(f & "\" & n & "(Result).csv", 2, True)
For Each d In myDic.keys
str = myDic(d) & String(9, ",")
v = Split(str, ",")
v2(0) = d
For L = 1 to 10
v2(L) = v(L-1)
Next
cr.WriteLine Join(v2, ",")
Next
cr.Close
myDic.RemoveAll
End If
Next
Set cv = Nothing
Set cr = Nothing
Set wa = Nothing
Set so = Nothing
Set myDic = Nothing
MsgBox("Finished!")
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

特集


感謝指数をマイページで確認!

ピックアップ

ページ先頭へ