[[20190120111617]] 『『シーケンス生成について。』その2』(ヤイリ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『『シーケンス生成について。』その2』(ヤイリ)

『シーケンス生成について。』その2

[[20190108200305]]では
いろいろとお世話になり
無理なご相談失礼いたしました。

ご回答者様から
コードがあったほうが
アドバイスしやすいとのことで
実際のコードは長いので
テスト用に編集しました。

『シーケンス生成について。』の
流れのご相談ですが

まずtest.csvに
(エクセルでいうAセルになります)
下記のデータが入っているとします。

0100104184
0100104184
0100104184
0100104184
0100500180
0100500180
0100500180
0100500180
0100500180
0100512347

現在、データを出力すると
testout.csvとして

0100104184,1
0100104184,2
0100104184,3
0100104184,4
0100500180,5
0100500180,6
0100500180,7
0100500180,8
0100500180,9
0100512347,10

連続番号が
付加され出力されるのですが
変数の
暗証番号(test.csvに入っているデータ)をキーに

0100104184,1-1
0100104184,1-2
0100104184,1-3
0100104184,1-4
0100500180,2-1
0100500180,2-2
0100500180,2-3
0100500180,2-4
0100500180,2-5
0100512347,3-1

と結果を出力したいのです。

StartNoを1から
スタートし

Array1のExport(1)から
連続番号を書き出しているのですが

Sub Main()の
increment = increment + 1の部分に
条件を加えたいのですが・・・

アドバイスいただけると助かります。

同じようなご質問で申し訳ございません。
度忘れしている事も多々あるかもしれません。
セル操作のサンプルの考え方から
出来ると思うのですが・・・
手づまりしております。

サンプルも色々とご提示いただいてはいるのですが
どうぞよろしくお願いいたします。

'*********************************************************************
'* 変数/定数定義
'*********************************************************************
Public 暗証番号 As String
Public increment As Long
Public inData() As String
Public Export() As String
Const outFieldRec As Long = 2
Const PathName As String = "C:\"
Const inFile As String = PathName & "test.csv"
Const TmpFile As String = PathName & "tmp.txt"
Const OutFile As String = PathName & "testout.csv"
Const TextType As String = "SHIFT-JIS"
Const Fs As String = ","

Sub Main()

Dim ReadTxt As Object
Dim SaveTxt As Object
Set ReadTxt = CreateObject("ADODB.stream")
Set SaveTxt = CreateObject("ADODB.stream")

Dim tmptxt As String
Dim j

ReadTxt.Type = adTypeText
SaveTxt.Type = adTypeText

ReadTxt.Charset = TextType
SaveTxt.Charset = TextType

ReadTxt.Open
SaveTxt.Open

ReadTxt.LoadFromFile (inFile)

Const StartNo As Long = 1
increment = StartNo
Do Until ReadTxt.EOS

  tmptxt = ReadTxt.ReadText(adReadLine)

  j = ArrReset()
  j = ReadField_split(tmptxt)

  連続番号 = increment

  j = tmpArrayMain(increment, tmptxt)

  SaveTxt.WriteText tmptxt, adWriteLine

  increment = increment + 1

Loop

SaveTxt.SaveToFile (OutFile), adSaveCreateOverWrite

ReadTxt.Close
SaveTxt.Close

Set ReadTxt = Nothing
Set SaveTxt = Nothing

End Sub

Function tmpArrayMain(increment As Long, ByRef tmptxt As String) As Long

ReDim Export(outFieldRec)

  tmptxt = ""

  j = inData2Wk(inData)

  j = Array0()
  j = Array1(increment)

  tmptxt = Export(0)
  For i = 1 To outFieldRec - 1
    tmptxt = tmptxt & "," & Export(i)
  Next i

tmpArray = 3

End Function

Function Array0()

   Export(0) = 暗証番号

End Function

Function Array1(increment As Long)

   Export(1) = increment

End Function

Function inData2Wk(inData) As Long

暗証番号 = inData(0)

  inData2Wk = 3

End Function

Function ReadField_split(ByRef strTmp As String) As Long

Dim lField As Long

ReDim inData(0)
iCount = cnt_str(strTmp, Fs)
ReDim inData(0 To iCount)

inData = Split(strTmp, Fs)

For i = 0 To iCount

Next i

ReadField_split = 2

End Function

Function ArrReset() As Integer

ReDim inData(0)
ArrReset = 1

End Function

Function cnt_str(strTmp As String, Fs As String) As Long

j = 0
If (Len(strTmp) > 0) Then

  For i = 1 To Len(strTmp)
    If (Mid(strTmp, i, 1) = Fs) Then
      j = j + 1
    End If
  Next i
  cnt_str = j
Else
  cnt_str = -1
End If

End Function

< 使用 Excel:Excel2016、使用 OS:Windows10 >


回答じゃなくて逆質問なんですが、私には「 CreateObject("ADODB.stream") 」がよくわからなかったので調べたら、
https://k-sugi.sakura.ne.jp/it_synthesis/windows/vb/3650/
がヒットしました。

上記には

通常のテキストファイルの読み込みや書き込みだと 文字コードがShift_jisでしか扱えません。 他の文字コードを使いたい場合はADODB.Streamを使います。

とあります。これが正しいとすると、

 Const TextType As String = "SHIFT-JIS"

であるなら、わざわざ「ADODB.Stream」使わなくてもいいように思うんですけど、将来文字コードが変わったりする可能性を考慮してのことなんでしょうか?

(もこな2) 2019/01/20(日) 12:31


 ファイルとのアクセスは抽象化して(無視して)
 B列の文字列を作成するところだけコードを書いて見ました。
 参考にしてください。
 前のスレッドも、貴兄のコードも殆ど読んでいませんので、
 重複等ありましらた済みません。

    A列         B列
  1 0100104184  0100104184,1-1
  2 0100104184  0100104184,1-2
  3 0100104184  0100104184,1-3
  4 0100104184  0100104184,1-4
  5 0100500180  0100500180,2-1
  6 0100500180  0100500180,2-2
  7 0100500180  0100500180,2-3
  8 0100500180  0100500180,2-4
  9 0100500180  0100500180,2-5
 10 0100512347  0100512347,3-1

 Sub test()
     Dim k As Long
     Dim s As String
     Dim counter1 As Object  ' 暗証番号ごとのカウンター
     Dim myCounter As Long
     Dim counter2 As Object  ' 同一暗証番号の中のカウンター

     Set counter1 = CreateObject("Scripting.Dictionary")
     Set counter2 = CreateObject("Scripting.Dictionary")
     myCounter = 0
     For k = 1 To 10
         s = Cells(k, 1).Value

         If Not counter1.Exists(s) Then
             myCounter = myCounter + 1
             counter1(s) = myCounter
             counter2(s) = 1
         Else
             counter2(s) = counter2(s) + 1
         End If
         Cells(k, 2).Value = s & "," & CStr(counter1(s)) & "-" & CStr(counter2(s))
     Next
 End Sub

(γ) 2019/01/20(日) 12:33


ファイルアクセス関係で付言すると、
Microsoft ActiveX Data Objects Recordset x.x Library
の参照設定がされているんだと思います。
ADOの Streamオブジェクトを使うのであれば。
でないと、adTypeTextがエラーとなります。
(γ) 2019/01/20(日) 12:39

 (もこな2)さん

 >であるなら、わざわざ「ADODB.Stream」使わなくてもいいように思うんですけ
 >ど、将来文字コードが変わったりする可能性を考慮してのことなんでしょうか? 

そうです。
実際のコードに近づけているので
そのままご提示させていただいたのですが
仕事によって、UTF-16やUTF-8等
文字コードを使い分ける場合もございます。
(ヤイリ) 2019/01/20(日) 12:43


 0100104184 
 0100104184 
 0100104184 
 0100104184 
 0100500180 
 0100500180 
 0100500180 
 0100500180 
 0100500180 
 0100512347

 というcsvファイルを

 0100104184,1-1 
 0100104184,1-2 
 0100104184,1-3 
 0100104184,1-4 
 0100500180,2-1 
 0100500180,2-2 
 0100500180,2-3 
 0100500180,2-4 
 0100500180,2-5 
 0100512347,3-1 

 という具合に出力するだけですよね?

 単純にデータを読み込んでDictionaryで連番を作成するのも一案ですが、ADO接続で

 元csvファイルは下記コードが記されているブックが保存されているフォルダにあるものと想定。

 Sub test()
     Dim cn As Object, rs As Object, x, y, txt As String
     Set cn = CreateObject("ADODB.Connection")
     Set rs = CreateObject("ADODB.Recordset")
     With cn
         .Provider = "Microsoft.Jet.OLEDB.4.0"
         .Properties("Extended Properties") = "Text;HDR=No;FMT=CSVDelimited;"
         .Open ThisWorkbook.Path
     End With
     rs.Open "Select Distinct F1 From `test.csv` Where F1 Is Not Null;", cn, 3
     x = rs.GetRows: rs.Close
     rs.Open "Select F1 From `test.csv` Where F1 Is Not Null;", cn, 3
     y = rs.GetRows: rs.Close
     Set cn = Nothing: Set rs = Nothing
     GetOutPut x, y
 End Sub 

 Private Sub GetOutPut(x, y)
     Dim i As Long, ii As Long, n As Long, t As Long, a
     ReDim a(1 To UBound(y, 2) + 1)
     For i = 0 To UBound(x, 2)
         For ii = 0 To UBound(y, 2)
             If x(0, i) = y(0, ii) Then
                 n = 0
                 Do While x(0, i) = y(0, ii + n)
                     t = t + 1
                     a(t) = y(0, ii + n) & "," & i + 1 & "-" & n + 1
                     n = n + 1
                     If ii + n > UBound(y, 2) Then Exit Do
                 Loop
                 Exit For
             End If
         Next
     Next
     Open ThisWorkbook.Path & "\test_with_Serial.csv" For Output As #1
         Print #1, Join(a, vbCrLf)
     Close #1
 End Sub
(seiya) 2019/01/20(日) 12:45
 修正:65536超データの考慮 13:07

(seiya)さん

という具合に出力するだけですよね?

ご連絡ありがとうござます。
ご提示いただきましたのは
参考になります。
今回は
実際には
レコード件数が多いので
Array→約Array(100)
Export→約Array(50)
一気に編集します。

私的にうまくいかないのが
暗証番号の2次元配列の判定の部分なので
アドバイスいただけたらと思いまして。

ご提示いただいたコードを
そのまま使用できたとしても
配列操作で理解できないと解決しませんし
今回はほかの編集もありますので
冒頭でご提示させていただいたコードで
解決できたらと思っております。
(ヤイリ) 2019/01/20(日) 13:20


冒頭で
ご質問した
Sub Main()の
increment = increment + 1の部分に
暗証番号をキーに
条件を加えたいのですが・・・
色々なサンプルを頂いてはいるのですが
ご提示させていただいたコードで
どなたかアドバイスいただけると助かります。
(ヤイリ) 2019/01/20(日) 13:22

 コードを読んで推測させたいならパス。
(seiya) 2019/01/20(日) 13:27

(γ)さん。
サンプルご提示ありがとうございます。

 >Microsoft ActiveX Data Objects Recordset x.x Library
 >の参照設定がされているんだと思います。 

ご説明しませんでしたが
参照設定にチェックを入れております。
アドバイスもありがとうございました。
(ヤイリ) 2019/01/20(日) 13:30


(seiya)さん。
了解しました。
サンプルのご提示どうもありがとうございました。
(ヤイリ) 2019/01/20(日) 13:33

>仕事によって、UTF-16やUTF-8等 文字コードを使い分ける場合もございます。

なるほど。SHIFT-JIS限定にはなりますし、このサイトの趣旨である「Excelに関すること」と離れるけど、こんなことを考えてみました。何かの参考にでもなれば幸いです。

    Sub Sample()
        Dim 主番号 As Long
        Dim 副番号 As Long
        Dim i As Long
        Dim tmp As Long: tmp = FreeFile
        Dim 元データ As Variant

        With CreateObject("Scripting.FileSystemObject").GetFile("C:\Sample\Data.txt").OpenAsTextStream
            元データ = Split(.readall, vbCrLf)
        End With

        主番号 = 1
        副番号 = 1

        Open "C:\Sample\out.txt" For Output As #tmp
        Print #tmp, 元データ(i) & "," & 主番号 & "-" & 副番号
        For i = LBound(元データ) + 1 To UBound(元データ)
            If 元データ(i) = 元データ(i - 1) Then
                副番号 = 副番号 + 1
            Else
                主番号 = 主番号 + 1
                副番号 = 1
            End If
            Print #tmp, 元データ(i) & "," & 主番号 & "-" & 副番号
        Next i
        Close #tmp

    End Sub

コード修正 2019/01/20(日) 14:19

(もこな2) 2019/01/20(日) 13:36


配列操作が目的だそうですが、
dictionaryは別名を連想配列といいます。
配列の一種です.......
(γ) 2019/01/20(日) 14:23

 ちなみに私のコードの x y a は全て配列。

(seiya) 2019/01/20(日) 15:03


 > ご提示させていただいたコードで 
 > どなたかアドバイスいただけると助かります。 

 アドバイスできるほどの力量はないので、教えてください。

 (1)
 まず、下記ですが、
     Do Until ReadTxt.EOS
         tmptxt = ReadTxt.ReadText(adReadLine)
         j = ArrReset()
         j = ReadField_split(tmptxt)
         連続番号 = increment
         j = tmpArrayMain(increment, tmptxt)
         SaveTxt.WriteText tmptxt, adWriteLine
         increment = increment + 1
     Loop
 一行ごとに処理をし、それを繰り返しているわけですよね。
 しかし、
 tmpArrayMainのなかで
     For i = 1 To outFieldRec - 1
         tmptxt = tmptxt & "," & Export(i)
     Next i
 カンマをつけて複数回連結していますよね。
 なぜですか?
 一行の処理ならカンマは一回つけるだけじゃないんですか?

 (2)
 ReadField_split の意味がわかりません。
 機能を説明していただけますか?        
 (3)
 tmpArrayMain についても一行毎にコメントをつけて機能を説明していただけますか?

(γ) 2019/01/20(日) 15:49


(Y)さん

(1)と(3)
jに各配列を宣言し、
Const outFieldRec As Long = 2で
Exportの数を設定しております。

inData2Wkは
入力データをワークスペースにコピーするで
伝わりますでしょうか。

例えばカンマで読み込んだデータを

 Exportしたい金額にカンマを付加させた場合に
 tmptxt = tmptxt & vbTab & Export(i)みたいに
タブ区切りや他の区切りで出力したい場合に使用しております。

(2)フィールド配列の分割格納になります。
jに対してフィールド格納しております。
説明が分かりにくい場合申し訳ございません。

(3)は(1)に含まれます。

これ以上分かりやすく伝えられるかどうか
分かりませんのでよろしくお願いいたします。
(ヤイリ) 2019/01/20(日) 17:11


(もこな2)さん。
サンプルのデータありがとうございます。
分かりやすく大変参考になりました。
もし、一気に編集するのが難しい場合
別編集し、あとから
SQL等でフィールド結合も考えております。
どうもありがとうございました。
(ヤイリ) 2019/01/20(日) 17:14

すみません。
皆さんからの回答で対応できる気がします。
dictionaryを強要するのは適当でないと考えまして、
発言を削除させていただきました。
 
ソートされたものがインプットされているなら、
直前のものと比較するだけで用は足りますね。
質問者さんどうも失礼。がんばってください。

(γ) 2019/01/20(日) 19:49


ああ、コードの説明ありがとうございます。礼を忘れました。
でも、
>jに各配列を宣言し、
とか本当なんですか?
j って、作業の進捗を示すflagみたいな感じですよね。
# 私は、こういう書き方は初めて見ました。一般的なんですか、こういう書き方。
# 本当に役に立つんだろうか、ロジックを追う邪魔になるだけのような。。。
(γ) 2019/01/20(日) 21:40

 >j って、作業の進捗を示すflagみたいな感じですよね。 
おっしゃる通りです。
集合体の進捗状態になります。
一般的かどうかわかりませんが・・・
コードをご提示する場合、初めて見る方は
邪魔かと思えば
邪魔かもしれません。

他のご質問も含めて
色々と勉強になります。
直近では
例えば
[[20181009203312]]

  『プロシージャが大きすぎますの対処方法』の
なんかでは
100000レコードある
本データで対応できたので
感謝しております。

アドバイスありがとうございました。

(ヤイリ) 2019/01/20(日) 23:15


 ちょっと疑問なんですが、 (ヤイリ) 2019/01/20(日) 13:30 の投稿で
  >参照設定にチェックを入れております。 
 ですよね。

 であれば、宣言もこっちのほうが候補でてやりやすいだろうし、参照設定が外れてしまった場合も
 推測しやすいと思いますがどうでしょう?
    Dim ReadTxt As ADODB.Stream ' As Object
    Dim SaveTxt As ADODB.Stream ' As Object
    Set ReadTxt = New ADODB.Stream ' CreateObject("ADODB.stream")
    Set SaveTxt = New ADODB.Stream 'CreateObject("ADODB.stream")
(稲葉) 2019/01/21(月) 10:17

ご指摘ありがとうございます。
正確にお伝えしますと
>参照設定にチェックを入れております。
ではななくチェック入れっぱなしです。

基本的にご提示する予定ではなかっので
ご報告
忘れてました。
(ヤイリ) 2019/01/21(月) 13:33


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.