各分類に分ける処理について

Question

前提・実現したいこと

実現したいこと

下記の記述で「成績リスト.txt」のレコード(行)を取得しています。
実現したいことは各行の情報を★補足の項目に分類する方法です。

前提
成績リスト.txt内は下記のような情報が入っています
★補足、左から日付(YYYYMMDD),学生番号(5桁0埋),名前(文字列),英語(点数),数学(点数)
値は都度変わる(月１回)

20190801,00001,Aさん,85,100
20190801,00002,Bさん,70,1
20190801,00003,Cさん,100,10
・
・
・

該当のソースコード

Option Explicit
 
　　Sub 成績レコード分類()
 
    Dim レコード As String
 
    Open ("成績リスト.txt") For Input As #1
 
    Do Until EOF(1)
        Line Input #1, レコード
        MsgBox レコード
    Loop
    Close #1
 
　　End Sub

試したこと

Split関数を使い1行ずつ分ける

Dim tmp As Variant
tmp = Split("20190801,00001,Aさん,85,100", ",")

　　　　　　・
・
・
行がたくさんあるので1行ずつ設定するのが大変また、値が都度変わるため固定で設定できない

Answer 1

ソースコードを見るとファイルから読み込んでいるようですので…
それなら最初からテーブルとして読み込んだほうが簡単なような気がします。

WorkBooks.openText Filename:="成績リスト.txt",DataType:=xlDelimited,Comma:=True

Answer 2

分割した後、どうしたいのでしょうか。
それにもよると思いますが、いちおうメッセージボックスに表示する場合のコード例

    Dim aryRec
    Do Until EOF(1)
        Line Input #1, レコード
        aryRec = Split(レコード, ",")
        MsgBox "日付:" & aryRec(0) 
        MsgBox "学生番号:" & aryRec(1) 
        MsgBox "名前:" & aryRec(2) 
        MsgBox "英語:" & aryRec(3) 
        MsgBox "数学:" & aryRec(4) 
    Loop

Comments

[Karaage_0630]

各項目ごとに分割した後は、
分割した項目(学籍番号(例：00001))を使ってエクセルブックの中から学籍番号(例：00001)を検索して、
一致した学生番号がいた場合、対象の学籍番号の各項目に値を付け加え、
また一致しない場合は、最終行に各項目の値を追加するようにしようと思ってます。

[hatena19]

そういうことなら、上記の回答のコードの Msgbox の部分を、
そういう処理になるように変更すればいいでしょう。

[Karaage_0630]

回答ありがとうございます。
最初にいただいた回答を参考に学習致します。

すみません記載漏れがありました。
正しくはこのプロシージャではレコードの読み込み、読み込んだデータを分割して分割したものを他のプロシージャに渡してそこで
上記の各項目ごとに分割した後は～になります。なのでこのプロシージャでは分割した後の処理としては値を渡すが正しかったです。

[hatena19]

いったんバリアント配列に格納して、aryRec(0) aryRec(1) で各列の値を取得できることが理解できれば応用できますよね。
それでやってみて行き詰ったらまた質問されたらいいかと思います。

[Karaage_0630]

返信遅くなり申し訳ありません。
テキストファイルの「成績リスト」の各項目を分けて各列の値を格納し別のプロシージャに渡すところはできた
のですが、
エクセルの「テストシート」からA列にある「学籍番号」を検索し、
一致していた場合、対象のC列の英語に値を足しこみ、
一致していない場合、最終行に、各分類（学籍番号、名前、英語、数学）の値を設定する記述にしたいのです
が、
下記の記述でうまく行きません。

Function 成績レコード分類()

Dim テストシート As Worksheet
Dim レコード As String
Dim 学籍番号 As String
Dim 名前 As String
Dim 英語 As Long
Dim 数学 As Long

Set テストシート = Workbooks("テストファイル").Worksheets("シート1")

Open 成績リスト For Input As #1

Dim aryRec As Variant

Do Until EOF(1)
Line Input #1, レコード
MsgBox レコード

aryRec = Split(レコード, ",")

MsgBox "日付:" & aryRec(0)

MsgBox "学籍番号:" & aryRec(1)
学籍番号 = aryRec(1)

MsgBox "名前:" & aryRec(2)
名前 = aryRec(2)

MsgBox "英語:" & aryRec(3)
英語 = aryRec(3)

MsgBox "数学:" & aryRec(4)
数学 = aryRec(4)

Call 設定処理(テストシート, 学籍番号, 名前, 英語, 数学)

Loop
Close #1

Function 設定処理(ByRef テストシート As Worksheet, ByVal 学籍番号 As String, ByVal 名前 As String,
ByVal 英語 As Long, ByVal 数学 As Long)

Dim i As Integer

　　 i = 1

'条件式：A〇セルが空白じゃない場合
Do While テストシート.Range("A" & i) <> ""

'A〇セルが空白じゃない場合に繰り返す処理
'学籍番号が一致する場合
If テストシート.Range("A" & i).Find(学籍番号) Then
テストシート.Range("C" & i) = 英語
i = i + 1

Else
'学籍番号が一致しなかった場合
　　テストシート.Range("A" & i) = 学籍番号
　　テストシート.Range("B" & i) = 名前
　　テストシート.Range("C" & i) = 英語
　　テストシート.Range("D" & i) = 数学
　　i = i + 1
End If

Loop

End Function

[Karaage_0630]

「テストシート」
A列　　　　　B　　　　C　　　　D
学籍番号　 名前 英語 数学
00001 あ　　　 0　　　 0
00002 い　　　 0　　　 0
00003 　 う　　　 0　　　 0
00004 　 え　　　 0　　　 0
00005 　 お　　　 0　　　 0
・
・
・
・

[hatena19]

この質問の関連ではありますが、新規の質問内容になりますので、新規に質問を立ててください。

[Karaage_0630]

わかりました。
ありがとうございます。

Answer 3

こんな感じじゃないかと思います。

        Dim tmp As Variant, i As Integer
        Dim w日付, w学生番号, w名前, w英語, w数学

        i = 0
        For Each tmp In Split(レコード, ",")
          i = i + 1
          Select Case i
          Case 1: w日付 = tmp
          Case 2: w学生番号 = tmp
          Case 3: w名前 = tmp
          Case 4: w英語 = tmp
          Case 5: w数学 = tmp
          End Select
        Next