お世話になります。 先日似たような質問をさせて頂き、解決したのですが改めて
新たな不明点が発生してしまい、依頼されている内容の為、恥ずかしながら質問させて
頂きたいと思います。
長くなってしまうかもしれませんが、できるだけ詳細に書きたいと思いますので
よろしければご協力おねがいします。
行いたい内容として、テキストファイルを利用して、Accessのテーブルに希望の内容を
書き込むことを目的としているのですが、個人でも本やネットを利用して、調べたりしているんですが、現状の自分の理解度を超えており、質問させて頂きたいと思います。
ご面倒かけ申し訳ありませんが、よろしくお願いいたします。
<テキストファイル>
AAA 1000 2000 3000 5000
BBB 3
2000 5000
1500 3000
1000 1500
AAA 300 800 1500 1000
BBB 4
1000 3000
1000 2500
2000 1300
1500 3000
BBB 2
5000 2000
2000 1000
上記のようなテキストファイルがあるのですが、これをAccessのテーブルへaddnewとupdateを
利用して書き込みを行いたいと思っています。
<テーブル構成>
ID オートナンバー
フィールド1 テキスト型
連番 数値型
このテーブル構成に対して、標準モジュールを利用して、下記のように加工したいです。
多少文字がずれてしまっていたら申し訳ありません。
<実行後のテーブル>
ID フィールド1 連番
1 1000 2000 1
2 3000 5000 1
3 2000 5000 2
4 1000 1500 2
5 300 800 3
6 1500 1000 3
7 1000 3000 4
8 1500 3000 4
9 5000 2000 5
10 2000 1000 5
ポイントとしまして
(1) AAAで始まる行については、2行に分ける
1000 2000 3000 5000 数字の間は、半角のスペース一つ分空いています。
Line Inputとsplitを利用して、配列で利用したいと思っています。
(2) BBBで始まる行については、最初の行と最後の行のみを利用します。
間にあるデータは利用しません。
(3) AAA・BBBの半角スペースの横にある数字は、次の行から何行データがあるか
表しています。
(4) AAAは、必ず2行になります。BBBは、最低2行になります。
(5) 連番については、AAA ・BBBともに、2行が同じ番号になります、
とりあえずできている内容を記載しておきます。
まだ条件分岐が全然できていません。
途中段階ではありますが、間違っている点・追加した方がいい点等ありましたら
変更していただいても大丈夫です。
Sub test()
Dim rsd As New ADODB.Recordset
Dim strLine As String
Dim arraystr As Variant
Dim iNum1 As Long
Dim iNum2 As Long
Dim iRecCnt As Long
Dim i As Long
'カレントファイルを開く
Open CurrentProject.Path & "\abcde.txt" For Input As #1
iNum1 = 0
iRecCnt = 0
Const sTable As String = "test1"
'abcdeテーブルデータ削除
Dim sSql As String
sSql = "DELETE * FROM " & sTable & ";"
CurrentProject.Connection.Execute sSql
'abcdeテーブルオープン
rsd.Open sTable, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
Do While Not EOF(1)
'テキスト データを一行ずつ読込
Line Input #1, strLine
'Nullを区切りとして配列をarraystrへ
arraystr = Split(strLine, " ")
Loop
End Sub
以上 よろしくお願いいたします
A 回答 (7件)
- 最新から表示
- 回答順に表示
No.7
- 回答日時:
No4に余計なものを残していました。
結果には何ら影響はないのですが、余計なループをしていました。ほかの
ことを考えていたためそのままにしていました。
取り除いたのは、
For i = 0 To UBound(arrayText)
と、途中の
Exit For
および
Next i
です。
したがって以下のようになります。
ADOに置き換えるのはNo6での記述に変更はありません。
失礼しました。
Sub test21()
Dim LineofText As String
Dim arrayText As Variant
Dim strPath As String
Dim i As Long
Dim j As Long
Dim flg As Long
Dim lnCount As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("test", dbOpenDynaset)
j = 0
flg = 0
lnCount = 0
'テキストファイルを開く
Open CurrentProject.Path & "\テキスト.txt" For Input As #1
'一行ずつ変数に読み込む
Do While Not EOF(1)
'ループのカウント
lnCount = lnCount + 1
Line Input #1, LineofText
'配列にデータを格納
arrayText = Split(LineofText, " ")
'配列の要素をテーブルに格納するための条件分岐
Select Case arrayText(0)
Case "AAA"
'連番の加算
j = j + 1
'"AAA"の場合のデータの書き込み
rs.AddNew
rs!フィールド1 = arrayText(1) & " " & arrayText(2)
rs!連番 = j
rs.Update
rs.AddNew
rs!フィールド1 = arrayText(3) & " " & arrayText(4)
rs!連番 = j
rs.Update
Erase arrayText
Case "BBB"
'カウンタとフラッグの初期化
lnCount = 0
flg = 0
'フラッグの設定
flg = arrayText(1)
'配列の初期化
Erase arrayText
'連番の加算
j = j + 1
Case Else
'最初と最後のデータの位置の設定
If lnCount = 1 Or flg = lnCount Then
'"BBB"の場合のデータの書き込み
rs.AddNew
rs!フィールド1 = arrayText(0) & " " & arrayText(1)
rs!連番 = j
rs.Update
Erase arrayText
End If
End Select
Loop
Close #1
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub
No.6
- 回答日時:
No4です。
質問ではADOとなっているので、No4をADOに変更する場合は、
最初の部分の変数とレコードセットのオープンまでは、
変更はADOの宣言の部分で、変数も合わせると、
Dim LineofText As String
Dim arrayText As Variant
Dim strPath As String
Dim i As Long
Dim j As Long
Dim flg As Long
Dim lnCount As Long
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open "test", cn, adOpenForwardOnly, adLockPessimistic
上記以降はずーっと同じで、最後のオブジェクトの処理で、
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub
となります。
中身は変わりませんが、以上です。
No.5
- 回答日時:
#2です
記述の勉強されているという事なので、何件か紹介します。
(参考にする/しない等々、自己責任でお願いします)
> 無駄を省くなりしてください。
と記述していましたが、TextToRec で
・登録する部分の関数化はやめる
・呼び飛ばす行分の領域はいらない
とした場合、以下の様な感じにも書けます。
Public Sub TextToRec2()
Dim rs As New ADODB.Recordset
Dim ffn As Integer
Dim iNum As Long
Dim sR As String, sSrc As String, sAry() As String
Dim i As Long, iRecCnt As Long
Dim sSql As String
Const sTable As String = "test1"
Const sFile As String = "\abcde.txt"
sSql = "DELETE * FROM " & sTable & ";"
CurrentProject.Connection.Execute sSql
rs.Open sTable, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iNum = 1
ffn = FreeFile()
Open CurrentProject.Path & sFile For Input As #ffn
While (Not EOF(ffn))
Line Input #ffn, sR
If (Left(sR, 3) = "AAA") Then
sSrc = Mid(sR, 5)
Else
iRecCnt = CLng(Split(sR, " ")(1))
For i = 1 To iRecCnt
Line Input #ffn, sR
Select Case i
Case 1: sSrc = sR
Case iRecCnt: sSrc = sSrc & " " & sR
End Select
Next
End If
sAry = Split(sSrc, " ")
For i = 0 To 2 Step 2
rs.AddNew
rs("フィールド1") = sAry(i) & " " & sAry(i + 1)
rs("連番") = iNum
rs.Update
Next
iNum = iNum + 1
Wend
Close #ffn
rs.Close
End Sub
もう1つ違う方法を紹介します。前回のご質問
Access VBA を利用 連番(+1)方法
http://oshiete.goo.ne.jp/qa/7776428.html
最後で schema.ini を使う手も・・・・と言ってましたが、以下で使ってみます。
abcde.txt を読み込む時に、Recordset として扱うように。
スペースで区切ったものが、フィールド何個目として扱えるので、
自分で頑張って Split しなくても良くなります。
以下の内容をメモ帳にコピーし、schema.ini 名で、abcde.txt と同じところに保存します。
[abcde.txt]
ColNameHeader=False
CharacterSet=OEM
Format=Delimited( )
Col1=F1 Char Width 255
Col2=F2 Char Width 255
Col3=F3 Char Width 255
Col4=F4 Char Width 255
Col5=F5 Char Width 255
内容的には、
abcde.txt の情報です。
ヘッダ(項目部分)はありません。
区切りは、スペースです。
区切った結果、左から F1 ~ F5 名として、テキスト型で扱って・・・
記述の詳細は、Web検索されると結構ありますので、そちらで理解してください。
前回のご質問では、このような定義をしていなかったので、Access さんが何行か読んで
この項目は、テキスト型として扱いましょうか・・・・等解釈しています。
品名のところを文字列にしていたら、テキスト型だね・・・・で、AAA がそのまま得られました。
品名のところを数字にしたら、数値として扱おうかな・・・で、AAA は数値じゃないので Null に。
なので、あの部分はうまくいっているように見えても、他のところはしっかり確認してください。
では、abcde.txt を Recordset として扱う例は以下です。
Public Sub TextToRec3()
Dim rs As New ADODB.Recordset
Dim rsFrom As New ADODB.Recordset
Dim iNum As Long
Dim i As Long, iRecCnt As Long
Dim sSql As String
Const sTable As String = "test1"
Const sFile As String = "abcde.txt"
sSql = "DELETE * FROM " & sTable & ";"
CurrentProject.Connection.Execute sSql
rs.Open sTable, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iNum = 1
rsFrom.Source = "SELECT * FROM [" & sFile & "] IN '" _
& CurrentProject.Path & "'[text;];"
rsFrom.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
While (Not rsFrom.EOF)
If (rsFrom(0) = "AAA") Then
For i = 1 To 3 Step 2
rs.AddNew
rs("フィールド1") = rsFrom(i) & " " & rsFrom(i + 1)
rs("連番") = iNum
rs.Update
Next
Else
iRecCnt = CLng(rsFrom(1))
For i = 1 To iRecCnt
rsFrom.MoveNext
If ((i = 1) Or (i = iRecCnt)) Then
rs.AddNew
rs("フィールド1") = rsFrom(0) & " " & rsFrom(1)
rs("連番") = iNum
rs.Update
End If
Next
End If
rsFrom.MoveNext
iNum = iNum + 1
Wend
rsFrom.Close
rs.Close
End Sub
前回のご質問での記述と、今回の記述の大きく異なる点は
前回) [Text;FMT=Delimited;HDR=YES;IMEX=1;]
今回) [Text;]
Schema.ini を使う時には、IMEX 記述があると解釈してくれないようです。
それを削除すると、区切り、ヘッダ情報は Schema.ini にあるので、あわせて削除。
という感じになっています。
※ 紹介した方法での各処理性能は分かりません。
#2での TextToRec / 今回の TextToRec2 の処理は、AAA の文字列に合わせましょう・・・
その合わせた文字列を展開して、2レコードを一緒に登録しましょう・・・・
としていましたが、BBB の出現頻度が多い・・・等々なら記述を見直したりしていきます。
No.4
- 回答日時:
No3です。
解決されたのかもしれませんが、再度回答します。
DAOやその他の設定はNo1と同じです。
質問の、
(2) BBBで始まる行については、最初の行と最後の行のみを利用します。
間にあるデータは利用しません。
については、
flgとlnCountという二つの数値を見比べてflg=1の場合と、
flg=lnCountの場合にデータを取り出すということで
クリアしています。
flgはたとえば"BBB 3"のときの3を表し、lnCountはループの回数
を表しています。
Sub test21()
Dim LineofText As String
Dim arrayText As Variant
Dim strPath As String
Dim i As Long
Dim j As Long
Dim flg As Long
Dim lnCount As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("test", dbOpenDynaset)
j = 0
flg = 0
lnCount = 0
'テキストファイルを開く
Open CurrentProject.Path & "\テキスト.txt" For Input As #1
'一行ずつ変数に読み込む
Do While Not EOF(1)
'ループのカウント
lnCount = lnCount + 1
Line Input #1, LineofText
'配列にデータを格納
arrayText = Split(LineofText, " ")
'配列の要素をテーブルに格納
For i = 0 To UBound(arrayText)
Select Case arrayText(0)
Case "AAA"
'連番の加算
j = j + 1
'"AAA"の場合のデータの書き込み
rs.AddNew
rs!フィールド1 = arrayText(1) & " " & arrayText(2)
rs!連番 = j
rs.Update
rs.AddNew
rs!フィールド1 = arrayText(3) & " " & arrayText(4)
rs!連番 = j
rs.Update
Erase arrayText
Exit For
Case "BBB"
'カウンタとフラッグの初期化
lnCount = 0
flg = 0
'フラッグの設定
flg = arrayText(1)
'配列の初期化
Erase arrayText
'連番の加算
j = j + 1
Exit For
Case Else
'最初と最後のデータの位置の設定
If lnCount = 1 Or flg = lnCount Then
'"BBB"の場合のデータの書き込み
rs.AddNew
rs!フィールド1 = arrayText(0) & " " & arrayText(1)
rs!連番 = j
rs.Update
Erase arrayText
Exit For
End If
End Select
Next i
Loop
Close #1
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub
No.3
- 回答日時:
No1です。
>(2) BBBで始まる行については、最初の行と最後の行のみを利用します。
> 間にあるデータは利用しません
の条件を抜かしていました。No1は一旦取り下げます。
No.2
- 回答日時:
何をやっているか、わかりやすそうな感じで書いてみました。
実際にはエラー処理を盛り込んだり、無駄を省くなりしてください。
連番を振る部分は、関数として独立。
・左3文字が AAA ならその後ろの文字列をそのまま
・AAA じゃなかったら必要な行分領域確保して、最初/最後をくっつけて
Public Sub TextToRec()
Dim rs As New ADODB.Recordset
Dim ffn As Integer
Dim iNum As Long
Dim sR As String, sAry() As String
Dim i As Long, iRecCnt As Long
Dim sSql As String
Const sTable As String = "test1"
Const sFile As String = "\abcde.txt"
sSql = "DELETE * FROM " & sTable & ";"
CurrentProject.Connection.Execute sSql
rs.Open sTable, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
iNum = 1
ffn = FreeFile()
Open CurrentProject.Path & sFile For Input As #ffn
While (Not EOF(ffn))
Line Input #ffn, sR
If (Left(sR, 3) = "AAA") Then
Call RecAdd(rs, iNum, Mid(sR, 5))
Else
iRecCnt = CLng(Split(sR, " ")(1))
ReDim sAry(1 To iRecCnt)
For i = 1 To iRecCnt
Line Input #ffn, sAry(i)
Next
Call RecAdd(rs, iNum, sAry(1) & " " & sAry(iRecCnt))
End If
Wend
Close #ffn
rs.Close
End Sub
Private Sub RecAdd(rs As ADODB.Recordset, iNum As Long, sSrc As String)
Dim sAry() As String
Dim i As Integer
sAry = Split(sSrc, " ")
For i = 0 To 2 Step 2
rs.AddNew
rs("フィールド1") = sAry(i) & " " & sAry(i + 1)
rs("連番") = iNum
rs.Update
Next
iNum = iNum + 1
End Sub
回答ありがとうございました。
こんなに早く回答いただけるとは思っておりませんでした。
ご回答頂いた内容を改めて見直して、理解と今後記述ができるように
勉強を進めたいと思います。
でもみなさんどうやってこんな詳しく慣れるんだろうと不思議になるくらいです。
ありがとうございました。
No.1
- 回答日時:
での応用、ということでDAOを使って回答します。
DAOの設定は上記に記しています。
なお、質問ではADOでの内容になっていますが、
条件分岐のところは同じなので、どちらでも
いいのではと思いますが。
一応、質問のようにテキストファイルのデータは、
AAAの場合は数値が4列、BBBはそれ以降に
数値が2列の行が複数出てくる、ということで
回答しています。このことが違っていれば
また、回答は出直しになりますが。
テーブル名は"test"、テキスト名は"テキスト.txt"としています。
以下です。
Sub test20()
Dim LineofText As String
Dim arrayText As Variant
Dim strPath As String
Dim i As Long
Dim j As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("test", dbOpenDynaset)
j = 0
'テキストファイルを開く
Open CurrentProject.Path & "\テキスト.txt" For Input As #1
'一行ずつ変数に読み込む
Do While Not EOF(1)
Line Input #1, LineofText
'配列にデータを格納
arrayText = Split(LineofText, " ")
'配列の要素をテーブルに格納
For i = 0 To UBound(arrayText)
Select Case arrayText(0)
Case "AAA"
j = j + 1
rs.AddNew
rs!フィールド1 = arrayText(1) & " " & arrayText(2)
rs!連番 = j
rs.Update
rs.AddNew
rs!フィールド1 = arrayText(3) & " " & arrayText(4)
rs!連番 = j
rs.Update
Erase arrayText
Exit For
Case "BBB"
Erase arrayText
j = j + 1
Exit For
Case Else
rs.AddNew
rs!フィールド1 = arrayText(0) & " " & arrayText(1)
rs!連番 = j
rs.Update
Erase arrayText
Exit For
End Select
Next i
Loop
Close #1
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub
何かあれば補足していください。
回答ありがとうございました。
こんなに早く回答いただけるとは思っておりませんでした。
実際に回答頂いた内容で実行してみましたら、希望通りの結果が返ってきました。
ただただ感謝です。
また、ご回答頂いた内容を改めて見直して、理解と今後記述ができるように
勉強を進めたいと思います。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelにて、フォルダ内のTextファイルをマクロで統合すると文字化けしてしまう時の解消コード 4 2023/01/01 07:32
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/15 15:48
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Excel(エクセル) マクロでテキストファイルを読み込んだ際の最終セルにデータと改行が含まれる問題の改善方法 2 2022/03/25 16:50
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Visual Basic(VBA) 貼り付けた値が消えていく 以下はソースファイルの2番目のシートのB6から最終行を取得 ターゲットファ 2 2023/07/27 12:23
- Access(アクセス) access,vbaでフォルダ内のファイルをテーブルにインポート、ファイル名もフィールドに追加したい 1 2022/08/31 11:11
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- その他(Microsoft Office) マクロVBAについて 1 2022/09/06 18:12
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
テーブルのデータ型の変更がで...
-
Accessのフィールド名に半角括...
-
Access VBA 添付型フィールド
-
アクセスでADO 並べ替えが適用...
-
Access 2010で実行時エラー3061
-
DataTableに特定のフィールドが...
-
accessでフィールド追加のあと...
-
Notes/Domino でアクセスカウン...
-
2つ目のレコードの値を取得す...
-
INT64対応のprintf系関数はあり...
-
2次元のdictionary
-
オートナンバー型を抽出条件に...
-
クリスタルレポート(8.5)の書式...
-
ノーツ:ユーザ名から別名を取...
-
アクセスで、テーブル間のレコ...
-
アクセス ADO Null以外のレコ...
-
クリスタルレポートで困ってい...
-
日付と文字列を条件としてDLook...
-
AS/400の論理ファイルで年度だ...
-
Accessの画像挿入のVBAコード
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
accessでフィールド追加のあと...
-
Accessのフィールド名に半角括...
-
クリスタルレポートで困ってい...
-
2つ目のレコードの値を取得す...
-
DataTableに特定のフィールドが...
-
Access 2010で実行時エラー3061
-
INT64対応のprintf系関数はあり...
-
テーブルのデータ型の変更がで...
-
AccessのDAOでフィールド名を配...
-
日付と文字列を条件としてDLook...
-
クリスタルレポートで文字列の...
-
クリスタルレポート(8.5)の書式...
-
Access VBA 添付型フィールド
-
Access クエリで変数を参照する...
-
Accessの画像挿入のVBAコード
-
NULLを含む文字列の結合で...
-
SQLで複数のテーブルと結合した...
-
オートナンバー型を抽出条件に...
-
ACCESSデータベースにV...
-
ACCESSで視覚的タイムテーブル...
おすすめ情報