teratail
回答率
85.30%
teratail header banner
teratail header banner
質問するログイン新規登録
トップに関する質問EXCEL VBAでサイン付きパック項目を含むデータを出力したい

編集履歴

質問編集履歴

4

現状を修正

2020/03/09 05:37

投稿

kawanishi_JUKE
kawanishi_JUKE

スコア5

title CHANGED
File without changes
body CHANGED
@@ -11,7 +11,11 @@
11
11
  2.パック項目を変換書き出し(seekで追記)
12
12
  3.パックが出てくるまで1を繰り返す
13
13
 
14
+ 'COMP-3項目を書き出す
15
+ の部分でサインなしであれば変換できています（00 00 00 01 00 00）
16
+ ただbyte形式で変換しているためcを入れることができない状況です。
14
17
 
18
+
15
19
  ### 該当のソースコード
16
20
 
17
21
 

3

2020/03/09 05:37

投稿

kawanishi_JUKE
kawanishi_JUKE

スコア5

title CHANGED
File without changes
body CHANGED
@@ -6,6 +6,12 @@
6
6
  ### 発生している問題・エラーメッセージ
7
7
  エクセル上で+00000001000と入力したデータをサイン付きパック項目00 00 00 01 00 0Cに変換する方法が分からない。
8
8
 
9
+ ### 現状
10
+ 1.バイナリでパック項目前までバイト形式にして書き出し
11
+ 2.パック項目を変換書き出し(seekで追記)
12
+ 3.パックが出てくるまで1を繰り返す
13
+
14
+
9
15
  ### 該当のソースコード
10
16
 
11
17
 
@@ -32,8 +38,6 @@
32
38
 
33
39
  '空いているファイル番号を取得します。
34
40
  FileNumber = FreeFile
35
- ' 'ファイルをAppendモードで開きます。
36
- ' Open strPath For Binary As #FileNumber
37
41
  With ActiveWorkbook.Worksheets("データ作成")
38
42
 
39
43
  'データをコピーする
@@ -71,7 +75,7 @@
71
75
  'パック項目が来たら一旦書き出す
72
76
  Erase bbuf
73
77
  bbuf = StrConv(s, vbFromUnicode)
74
- 'ファイルをAppendモードで開きます。
78
+
75
79
  Open strPath For Binary As #FileNumber
76
80
 
77
81
  'データ書き出し
@@ -88,7 +92,7 @@
88
92
  cData((j - 1) / 2) = CByte("&H" & Mid(s, j, 2))
89
93
  Next
90
94
 
91
- 'ファイルをAppendモードで開きます。
95
+
92
96
  Open strPath For Binary As #FileNumber
93
97
 
94
98
  'データ書き出し
@@ -110,7 +114,7 @@
110
114
  copyCol = copyCol + 1
111
115
  Loop
112
116
 
113
- 'パック項目が来たら一旦書き出す
117
+
114
118
  Erase bbuf
115
119
  bbuf = StrConv(s, vbFromUnicode)
116
120
  'ファイルをAppendモードで開きます。
@@ -120,14 +124,8 @@
120
124
  Put #FileNumber, , bbuf
121
125
  '入力ファイルを閉じます。
122
126
  Close #FileNumber
123
-
124
-
125
-
126
127
  End With
127
-
128
-
129
- ' 'データ書き出し
128
+
130
- ' Put #FileNumber, 1, bbuf
131
129
  '入力ファイルを閉じます。
132
130
  Close #FileNumber
133
131
  ```

2

ソース修正

2020/03/09 04:59

投稿

kawanishi_JUKE
kawanishi_JUKE

スコア5

title CHANGED
File without changes
body CHANGED
@@ -7,10 +7,11 @@
7
7
  エクセル上で+00000001000と入力したデータをサイン付きパック項目00 00 00 01 00 0Cに変換する方法が分からない。
8
8
 
9
9
  ### 該当のソースコード
10
- Sub データ出力()
11
10
 
11
+
12
- 'データ格納用
12
+ 　　'データ格納用
13
+ ```Sub データ出力()
13
- Dim bbuf() As Byte
14
+ 　　　Dim bbuf() As Byte
14
15
  Dim s As String
15
16
  Dim bData() As Byte
16
17
  Dim cData() As Byte
@@ -128,4 +129,5 @@
128
129
  ' 'データ書き出し
129
130
  ' Put #FileNumber, 1, bbuf
130
131
  '入力ファイルを閉じます。
131
- Close #FileNumber
132
+ Close #FileNumber
133
+ ```

1

ソース追加

2020/03/09 04:45

投稿

kawanishi_JUKE
kawanishi_JUKE

スコア5

title CHANGED
File without changes
body CHANGED
@@ -7,4 +7,125 @@
7
7
  エクセル上で+00000001000と入力したデータをサイン付きパック項目00 00 00 01 00 0Cに変換する方法が分からない。
8
8
 
9
9
  ### 該当のソースコード
10
+ Sub データ出力()
11
+
12
+ 'データ格納用
10
- dim bbuf() as byte
13
+ Dim bbuf() As Byte
14
+ Dim s As String
15
+ Dim bData() As Byte
16
+ Dim cData() As Byte
17
+
18
+ 'ファイル作成
19
+ Dim objFso As Object
20
+ Set objFso = CreateObject("Scripting.FileSystemObject")
21
+
22
+ Dim strPath As String
23
+ strPath = ActiveWorkbook.Worksheets("データ作成").Range("C1").Value
24
+
25
+ With objFso
26
+ If Not .FileExists(strPath) Then
27
+ .CreateTextFile (strPath)
28
+ End If
29
+ End With
30
+ Set objFso = Nothing
31
+
32
+ '空いているファイル番号を取得します。
33
+ FileNumber = FreeFile
34
+ ' 'ファイルをAppendモードで開きます。
35
+ ' Open strPath For Binary As #FileNumber
36
+ With ActiveWorkbook.Worksheets("データ作成")
37
+
38
+ 'データをコピーする
39
+ copyCol = 24
40
+ Do While .Cells(copyCol, 2) <> ""
41
+ Select Case .Cells(copyCol, 2)
42
+ 'ヘッダ時の処理
43
+ Case "ヘッダ"
44
+ itemsu = 134
45
+ dataGata = 8
46
+ '商品時の処理
47
+ Case "エンド"
48
+ itemsu = 2
49
+ dataGata = 23
50
+ '対象レコード以外の処理
51
+ Case Else
52
+ MsgBox "レコード区分に誤りがあります！！"
53
+ Exit Do
54
+ End Select
55
+
56
+ 'アイテム数分ループする
57
+ For i = 0 To itemsu - 1
58
+
59
+ If .Cells(copyCol, 2) = "ヘッダ" And i = 0 Then
60
+ s = s & "10 "
61
+ i = 1
62
+ Else
63
+ If .Cells(copyCol, 2) = "エンド" And i = 0 Then
64
+ s = s & "99 "
65
+ i = 1
66
+ Else
67
+
68
+ If .Cells(dataGata, 3 + i) = "COMP-3" Then
69
+
70
+ 'パック項目が来たら一旦書き出す
71
+ Erase bbuf
72
+ bbuf = StrConv(s, vbFromUnicode)
73
+ 'ファイルをAppendモードで開きます。
74
+ Open strPath For Binary As #FileNumber
75
+
76
+ 'データ書き出し
77
+ Seek #FileNumber, FileLen(strPath) + 1
78
+ Put #FileNumber, , bbuf
79
+ '入力ファイルを閉じます。
80
+ Close #FileNumber
81
+ s = ""
82
+
83
+ 'COMP-3項目を書き出す
84
+ ReDim cData(0 To Len(.Cells(copyCol, 3 + i).Value) / 2 - 1)
85
+ s = Mid(Cells(copyCol, 3 + i).Value, 2, Len(Cells(copyCol, 3 + i).Value) - 1)
86
+ For j = 1 To Len(.Cells(copyCol, 3 + i).Value) Step 2
87
+ cData((j - 1) / 2) = CByte("&H" & Mid(s, j, 2))
88
+ Next
89
+
90
+ 'ファイルをAppendモードで開きます。
91
+ Open strPath For Binary As #FileNumber
92
+
93
+ 'データ書き出し
94
+ Seek #FileNumber, FileLen(strPath) + 1
95
+ Put #FileNumber, , cData
96
+ '入力ファイルを閉じます。
97
+ Close #FileNumber
98
+ s = ""
99
+
100
+ Else
101
+ '通常項目
102
+ s = s & .Cells(copyCol, 3 + i).Value
103
+ End If
104
+ End If
105
+ End If
106
+
107
+ Next
108
+ '次レコードへ
109
+ copyCol = copyCol + 1
110
+ Loop
111
+
112
+ 'パック項目が来たら一旦書き出す
113
+ Erase bbuf
114
+ bbuf = StrConv(s, vbFromUnicode)
115
+ 'ファイルをAppendモードで開きます。
116
+ Open strPath For Binary As #FileNumber
117
+ 'データ書き出し
118
+ Seek #FileNumber, FileLen(strPath) + 1
119
+ Put #FileNumber, , bbuf
120
+ '入力ファイルを閉じます。
121
+ Close #FileNumber
122
+
123
+
124
+
125
+ End With
126
+
127
+
128
+ ' 'データ書き出し
129
+ ' Put #FileNumber, 1, bbuf
130
+ '入力ファイルを閉じます。
131
+ Close #FileNumber