投稿日 | : 2004/07/23(Fri) 17:58 |
投稿者 | : りっとっと |
Eメール | : |
URL | : |
タイトル | : Re: また教えてほしいのですが |
あまりいい方法が思い浮かびませんね。
ADOなどを使用する方法をお勧めいたします。
自作関数などですと、ファイルサイズが大きくなるとその分処理に時間がかかりますからね。
あと、逆引きに載っている方法が一番スマートだと思われますが、
一応前回のを改良したものをのせます。
.frmファイルの内容を全部載せますので、メモ帳を開きコピペして、"xxx.frm"として保存してください。あとは、新規プロジェクトで、保存したfrmファイルを追加し、スタートアップに設定して実行
してみてください。
'frmファイルの内容
VERSION 5.00
Begin VB.Form frmCSVSample
Caption = "CSVファイルの読み込み修正サンプル"
ClientHeight = 2115
ClientLeft = 60
ClientTop = 345
ClientWidth = 3870
LinkTopic = "Form1"
ScaleHeight = 2115
ScaleWidth = 3870
StartUpPosition = 3 'Windows の既定値
Begin VB.TextBox txtKamoku
Height = 270
Left = 840
TabIndex = 4
Top = 120
Width = 2055
End
Begin VB.TextBox txtRireki
Height = 270
Index = 2
Left = 840
TabIndex = 3
Top = 1320
Width = 2055
End
Begin VB.TextBox txtRireki
Height = 270
Index = 1
Left = 840
TabIndex = 2
Top = 960
Width = 2055
End
Begin VB.TextBox txtRireki
Height = 270
Index = 0
Left = 840
TabIndex = 1
Top = 600
Width = 2055
End
Begin VB.CommandButton cmdHozon
Caption = "保存"
Height = 375
Left = 2160
TabIndex = 0
Top = 1680
Width = 735
End
Begin VB.Label Label2
Caption = "科目"
Height = 255
Left = 480
TabIndex = 8
Top = 120
Width = 375
End
Begin VB.Label Label1
Caption = "3回目"
Height = 255
Index = 2
Left = 360
TabIndex = 7
Top = 1320
Width = 495
End
Begin VB.Label Label1
Caption = "2回目"
Height = 255
Index = 1
Left = 360
TabIndex = 6
Top = 960
Width = 495
End
Begin VB.Label Label1
Caption = "1回目"
Height = 255
Index = 0
Left = 360
TabIndex = 5
Top = 600
Width = 495
End
End
Attribute VB_Name = "frmCSVSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Data() As String
Private Buf() As String
Private csvFileName As String
Private Cnt As Long
Private Cnt2 As Long
Private Cnt3 As Long
'保存ボタンが押されたらファイルに保存します
Private Sub cmdHozon_Click()
Open csvFileName For Binary As #1
'改行コードをCrLfにしています。環境などに応じて変更してください
Put #1, , Join(Data, vbCrLf)
Close #1
End Sub
Private Sub Form_Load()
Dim rCnt As Long
csvFileName = "c:\test.csv"
OpenCSV
'初期表示データを国語とします
txtKamoku.Text = "国語"
Call ChangeKamoku(txtKamoku.Text)
End Sub
'CSVファイルを開きます
Private Sub OpenCSV()
Dim bin() As Byte
Dim strData As String
Open csvFileName For Binary As #1
ReDim bin(LOF(1) - 1)
Get #1, , bin
Close #1
strData = StrConv(bin, vbUnicode)
strData = Replace(strData, vbCrLf, vbLf)
strData = Replace(strData, vbCr, vbLf)
Data = Split(strData, vbLf)
End Sub
'設定された科目の点数を表示
Private Function ChangeKamoku(Kamoku As String)
For Cnt = 1 To 3
txtRireki(Cnt - 1).Text = GetData(txtKamoku.Text, Cnt)
Next
End Function
'カンマ区切りの最初の部分が科目名で履歴が左から1回目、2回目...という前提とします
Private Function GetData(Kamoku As String, Optional Rireki As Long = -1) As String
For Cnt2 = 0 To UBound(Data)
If Data(Cnt2) = "" Then Exit For
Buf = Split(Data(Cnt2), ",")
If Buf(0) = Kamoku Then
GetData = Buf(Rireki)
Exit Function
End If
Next
End Function
'点数を修正します
Private Function UpdateData(Kamoku As String, Rireki As Long, Tensu As String) As String
For Cnt = 0 To UBound(Data)
If Data(Cnt) <> "" Then
Buf = Split(Data(Cnt), ",")
If Buf(0) = Kamoku Then
Buf(Rireki) = Tensu
Data(Cnt) = Join(Buf, ",")
Exit For
End If
End If
Next
End Function
'エンターキーが押されたら表示する点数を変更
Private Sub txtKamoku_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
Call ChangeKamoku(txtKamoku.Text)
End If
End Sub
'リアルタイムに修正
Private Sub txtRireki_Change(Index As Integer)
Call UpdateData(txtKamoku.Text, Index + 1, txtRireki(Index).Text)
End Sub