teratail
回答率
85.47%
質問するログイン新規登録
トップVBAに関する質問ACCESSでCSVデータの集計

編集履歴

回答編集履歴

2

不要な定数を削除

2018/09/27 06:25

投稿

hixtutokun
hixtutokun

スコア21

test CHANGED
@@ -11,8 +11,6 @@
11
11
  Public Sub ImportCSVFiles()
12
12
 
13
13
  Const DIR_CSV = "YOUR_CSVFILES_DIRECTORY"
14
-
15
- Const PATH_OUTPUT = DIR_CSV & "\" & "OUTPUT.csv"
16
14
 
17
15
  Const MAX_CSV_FILENUM = 300
18
16
 

1

CSVファイルへの書き出しからデータベースへの読み込みに変更

2018/09/27 06:25

投稿

hixtutokun
hixtutokun

スコア21

test CHANGED
@@ -1,10 +1,14 @@
1
- 出力データ仕様をみたところ、複数のcsvファイルを一つのcsvファイルにまとめたいのでしょうか？でしたらテーブルに読み込む必要はありません。勘違いでしたらごめんなさい。
1
+ 愚直に一つずつcsvファイルを読み込んで、それを一行ずつデータベースに読み込めば良いと思います。テーブルはあらかじめ作成しましょう。その際m付きの値をDoubleに変換します。
2
2
 
3
- 一つずつcsvファイルを読み込んで、それを一行ずつ出力用ファイルに書き込めば良いと思います。以下に例を載せます。参照設定で Microsoft Scripting Runtime を追加しています。
3
+ 以下にコードを載せます。参照設定で Microsoft Scripting Runtime を追加しています。
4
+
5
+ 解決のヒントになれば幸いです。
4
6
 
5
7
  ```vba
6
8
 
9
+
10
+
7
- Public Sub ReduceCSVFiles()
11
+ Public Sub ImportCSVFiles()
8
12
 
9
13
  Const DIR_CSV = "YOUR_CSVFILES_DIRECTORY"
10
14
 
@@ -12,65 +16,67 @@
12
16
 
13
17
  Const MAX_CSV_FILENUM = 300
14
18
 
15
-
16
19
 
17
- Dim FSO As FileSystemObject: Set FSO = New FileSystemObject
18
20
 
19
- Dim TS_Out As TextStream: Set TS_Out = FSO.OpenTextFile(PATH_OUTPUT, ForAppending, True)
21
+ Dim DB As Database: Set DB = CurrentDb
20
22
 
21
-
23
+ Dim RS As Recordset: Set RS = DB.OpenRecordset("YOUR_TABLE")
24
+
25
+
22
26
 
23
27
  Dim FileNum As Long
24
28
 
25
29
  For FileNum = 1 To MAX_CSV_FILENUM
26
30
 
27
- AppendCSVToOut DIR_CSV & "\" & FileNum & ".csv", FileNum, TS_Out
31
+ ImportCSVFile RS, DIR_CSV & "\" & FileNum & ".csv", FileNum
28
32
 
29
33
  Next
30
34
 
31
-
32
35
 
36
+
33
- TS_Out.Close
37
+ RS.Close
38
+
39
+ DB.Close
34
40
 
35
41
  End Sub
36
42
 
37
43
 
38
44
 
39
- Private Sub AppendCSVToOut(ByVal CSVFilePath As String, ByVal FileNum As Long, ByVal TS_Out As TextStream)
45
+ Private Sub ImportCSVFile(ByVal RS As Recordset, ByVal CSVFilePath As String, ByVal FileNum As Long)
40
46
 
41
47
  Dim FSO As FileSystemObject: Set FSO = New FileSystemObject
42
48
 
43
- Dim TS_In As TextStream: Set TS_In = FSO.OpenTextFile(CSVFilePath)
49
+ Dim TS As TextStream: Set TS = FSO.OpenTextFile(CSVFilePath)
44
50
 
45
51
  Dim Row As Variant
46
52
 
47
- Do Until TS_In.AtEndOfStream
53
+ Do Until TS.AtEndOfStream
48
54
 
49
- Row = Split(TS_In.ReadLine, ",")
55
+ Row = Split(TS.ReadLine, ",")
50
56
 
51
- TS_Out.WriteLine Join(Array( _
57
+ RS.AddNew
52
58
 
53
- FileNum, _
59
+ RS!NO = FileNum
54
60
 
55
- Row(1), _
61
+ RS!R# = Row(1)
56
62
 
57
- Row(2), _
63
+ RS!TP1 = Row(2)
58
64
 
59
- Row(3), _
65
+ RS!TP2 = Row(3)
60
66
 
61
- ParseMinMax(Row(4)), _
67
+ RS!Min = ConvMinMaxToDbl(Row(4))
62
68
 
63
- ParseMinMax(Row(5)), _
69
+ RS!Max = ConvMinMaxToDbl(Row(5))
64
70
 
65
- Row(6), _
71
+ RS!Result = Row(6)
66
72
 
67
- Row(7) _
73
+ RS!Actual = Row(7)
68
74
 
69
- ), ",")
75
+ RS.Update
70
76
 
71
77
  Loop
72
78
 
73
- TS_In.Close
79
+ TS.Close
74
80
 
75
81
  End Sub
76
82
 
@@ -78,15 +84,15 @@
78
84
 
79
85
  ' 21.72m -> 0.02172
80
86
 
81
- Private Function ParseMinMax(ByVal NumLikeStr As String) As Double
87
+ Private Function ConvMinMaxToDbl(ByVal NumLikeStr As String) As Double
82
88
 
83
89
  If NumLikeStr Like "*m" Then
84
90
 
85
- ParseMinMax = CDbl(Replace(NumLikeStr, "m", "")) / 1000
91
+ ConvMinMaxToDbl = CDbl(Replace(NumLikeStr, "m", "")) / 1000
86
92
 
87
93
  Else
88
94
 
89
- ParseMinMax = CDbl(NumLikeStr)
95
+ ConvMinMaxToDbl = CDbl(NumLikeStr)
90
96
 
91
97
  End If
92
98