teratail
回答率
85.48%
質問するログイン新規登録
トップに関する質問VBA シートにコピーで数値が変わってしまう

編集履歴

質問編集履歴

5

追記

2019/11/12 09:29

投稿

kitagawasho
kitagawasho

スコア28

test CHANGED
@@ -1 +1 @@
1
- VBA コピーで数値が変わってしまう
1
+ VBA シートにコピーで数値が変わってしまう
test CHANGED
@@ -2,7 +2,7 @@
2
2
 
3
3
 
4
4
 
5
- 新しいシートにコピーする際に、中身が変わってしまう。
5
+ 新しいシートにコピーする際に、中身が少し変わってしまう。
6
6
 
7
7
  正しい値をコピーしたい
8
8
 
@@ -14,10 +14,10 @@
14
14
 
15
15
  ```
16
16
 
17
-
18
-
19
17
  新シートに貼り付けの部分で書式や行数はコピーできているが、値などが途中から違い、しっかりコピーできていない。
20
18
 
19
+ →ソースコードには問題はなでーたいのか？
20
+
21
21
  例のように値が変わってしまっている。
22
22
 
23
23
  例：
@@ -94,39 +94,107 @@
94
94
 
95
95
  'コピー元を新シートに貼り付け
96
96
 
97
- Range("A1").Select
97
+ Range("A1").Select
98
98
 
99
99
  ActiveSheet.paste
100
100
 
101
101
 
102
102
 
103
- Dim datafile As String
104
-
105
- Dim f_num As Integer ' ファイル番号
106
-
107
- datafile = ActiveWorkbook.Path & "\test(1).txt"
108
-
109
- f_num = FreeFile
110
-
111
-
112
-
113
- Open datafile For Output As #1
114
-
115
-
116
-
117
- Dim i As Long
118
-
119
- i = 1
120
-
121
- For i = 1 To 1149
122
-
123
- Print #f_num, Cells(i, "A").Value
124
-
125
- Next i
126
-
127
- Close f_num
128
-
129
-
103
+ Dim rUsed As Range '// UsedRange
104
+
105
+ Dim r As Range '// Cell
106
+
107
+ Dim fs As New FileSystemObject '// FileSystemObject
108
+
109
+ Dim ts As TextStream '// TextStream
110
+
111
+ Dim sFilePath '// 出力ファイルパス
112
+
113
+ Dim iRow '// 現在行
114
+
115
+ Dim s '// 出力文字列
116
+
117
+
118
+
119
+ '// ファイルパス＝ブックと同じフォルダ＋シート名＋.txt
120
+
121
+ sFilePath = ActiveWorkbook.Path & "\test(1).txt"
122
+
123
+
124
+
125
+ '// FileSystemObjectで新規ファイル作成
126
+
127
+ Set ts = fs.CreateTextFile(sFilePath, True, False)
128
+
129
+
130
+
131
+ '// シートの入力範囲の全セルを取得
132
+
133
+ Set rUsed = ActiveSheet.UsedRange
134
+
135
+
136
+
137
+ iRow = 0
138
+
139
+
140
+
141
+ '// 1セルずつループ
142
+
143
+ For Each r In rUsed
144
+
145
+ If iRow <> r.Row Then
146
+
147
+ '// ループ初回時ではない場合
148
+
149
+ If r.Row <> rUsed.Row Or r.Column <> rUsed.Column Then
150
+
151
+ '// 行が変わったため改行コードを付与
152
+
153
+ s = s & vbCrLf
154
+
155
+ End If
156
+
157
+
158
+
159
+ '// 行の先頭値を連結
160
+
161
+ s = s & r.Text
162
+
163
+ Else
164
+
165
+ '// タブ文字区切りで連結
166
+
167
+ s = s & vbTab & r.Text
168
+
169
+ End If
170
+
171
+
172
+
173
+ '// 現在行取得
174
+
175
+ iRow = r.Row
176
+
177
+ Next
178
+
179
+
180
+
181
+ '// セルの文字列が存在する場合
182
+
183
+ If s <> "" Then
184
+
185
+ Call ts.WriteLine(s)
186
+
187
+ ' Call ts.Write(s)
188
+
189
+ ' Call ts.Write(vbCrLf)
190
+
191
+ End If
192
+
193
+
194
+
195
+ '// ファイルClose
196
+
197
+ Call ts.Close
130
198
 
131
199
 
132
200
 
@@ -134,6 +202,8 @@
134
202
 
135
203
 
136
204
 
205
+
206
+
137
207
  ```
138
208
 
139
209
 

4

追記

2019/11/12 09:29

投稿

kitagawasho
kitagawasho

スコア28

test CHANGED
@@ -1 +1 @@
1
- VBA コピーとテキスト出力
1
+ VBA コピーで数値が変わってしまう
test CHANGED
@@ -2,9 +2,9 @@
2
2
 
3
3
 
4
4
 
5
- 1部のデータを新シートにコピーし、そのシートをテキスト出力したい。
5
+ 新しいシートにコピーする際に、中身が変わってしまう。
6
6
 
7
- 保存に関しては現状の動作で大丈夫です。
7
+ 正しい値をコピーしたい
8
8
 
9
9
 
10
10
 
@@ -14,15 +14,9 @@
14
14
 
15
15
  ```
16
16
 
17
- 1.新シートをテキスト出力しようとすると、最初の3行分しか出力できていない。
18
-
19
- 　おそらく、4行目は改行の為。
20
-
21
- →改行を2行連続でしたら、ループを抜け出したい
22
17
 
23
18
 
24
-
25
- 2.新シートに貼り付けの部分で書式や行数はコピーできているが、値などが途中から違い、しっかりコピーできていない。
19
+ 新シートに貼り付けの部分で書式や行数はコピーできているが、値などが途中から違い、しっかりコピーできていない。
26
20
 
27
21
  例のように値が変わってしまっている。
28
22
 
@@ -108,9 +102,13 @@
108
102
 
109
103
  Dim datafile As String
110
104
 
105
+ Dim f_num As Integer ' ファイル番号
106
+
111
107
  datafile = ActiveWorkbook.Path & "\test(1).txt"
112
108
 
113
-
109
+ f_num = FreeFile
110
+
111
+
114
112
 
115
113
  Open datafile For Output As #1
116
114
 
@@ -120,21 +118,15 @@
120
118
 
121
119
  i = 1
122
120
 
123
- Do While ws.Cells(i, 1).Value <> ""
121
+ For i = 1 To 1149
124
122
 
125
- Print #1, ws.Cells(i, 1).Value
123
+ Print #f_num, Cells(i, "A").Value
126
124
 
127
- i = i + 1
125
+ Next i
128
126
 
129
- Loop
127
+ Close f_num
130
128
 
131
129
 
132
-
133
- Close #1
134
-
135
-
136
-
137
- MsgBox "test(1).txtに書き出しました"
138
130
 
139
131
 
140
132
 
@@ -150,12 +142,6 @@
150
142
 
151
143
 
152
144
 
153
- テキスト出力についてはセルA1にカーソルを合わせて全選択したら、
154
-
155
- 3行分しか選択できなかった。
156
-
157
- 上記のソースコードだとシート内すべてをテキスト出力できないのか？
158
-
159
145
  ### 補足情報（FW/ツールのバージョンなど）
160
146
 
161
147
 

3

追記

2019/11/12 08:39

投稿

kitagawasho
kitagawasho

スコア28

test CHANGED
File without changes
test CHANGED
@@ -15,6 +15,10 @@
15
15
  ```
16
16
 
17
17
  1.新シートをテキスト出力しようとすると、最初の3行分しか出力できていない。
18
+
19
+ 　おそらく、4行目は改行の為。
20
+
21
+ →改行を2行連続でしたら、ループを抜け出したい
18
22
 
19
23
 
20
24
 

2

タグ追加

2019/11/12 08:32

投稿

kitagawasho
kitagawasho

スコア28

test CHANGED
File without changes
test CHANGED
File without changes

1

質問の内容とソースコードの更新

2019/11/12 08:26

投稿

kitagawasho
kitagawasho

スコア28

test CHANGED
@@ -1 +1 @@
1
- VBA パス先に保存
1
+ VBA コピーとテキスト出力
test CHANGED
@@ -2,11 +2,9 @@
2
2
 
3
3
 
4
4
 
5
- 保存先をパスを設定してそこに保存したいと考えています。
5
+ 1部のデータを新シートにコピーし、そのシートをテキスト出力したい。
6
6
 
7
- A1にパスを設定したとしてどのようにすればいいか教えてください。
7
+ 保存に関しては現状の動作で大丈夫です。
8
-
9
-
10
8
 
11
9
 
12
10
 
@@ -15,6 +13,52 @@
15
13
 
16
14
 
17
15
  ```
16
+
17
+ 1.新シートをテキスト出力しようとすると、最初の3行分しか出力できていない。
18
+
19
+
20
+
21
+ 2.新シートに貼り付けの部分で書式や行数はコピーできているが、値などが途中から違い、しっかりコピーできていない。
22
+
23
+ 例のように値が変わってしまっている。
24
+
25
+ 例：
26
+
27
+ ################ 　　　　　　　　################
28
+
29
+ # 移動番号 -1 # 　　　　　　　　# 移動番号 -1 #
30
+
31
+ ################ 　　　 ################
32
+
33
+ # a # a
34
+
35
+ 1 0
36
+
37
+ # b # b
38
+
39
+ -1 0
40
+
41
+ # c # c
42
+
43
+ 2 0
44
+
45
+ # d → # d
46
+
47
+ 1 0
48
+
49
+ # e # e
50
+
51
+ -90 0
52
+
53
+ # f # f
54
+
55
+ 0 0
56
+
57
+ # g # g
58
+
59
+ 0 0 0 0 0 0
60
+
61
+
18
62
 
19
63
 
20
64
 
@@ -28,41 +72,71 @@
28
72
 
29
73
  ```VBA
30
74
 
31
- Sub std_1()
75
+ Sub aaa()
32
76
 
33
77
  Application.ScreenUpdating = False
34
78
 
35
- If Range("L4").Value = "1554.2" Then
79
+ 'コピー元の選択
36
80
 
37
- If Range("M4").Value = "1500" Then
81
+ Range("A15:E1163").Select
38
82
 
39
- If Range("N4").Value = "240" Then
83
+ Selection.Copy
40
84
 
41
- Worksheets("■CG_R_B(固定軌跡)").Select
42
85
 
43
- Range("A6:E701").Select
44
86
 
45
- Selection.Copy
87
+ '追加したシートに名前を付ける
46
88
 
47
- Shell "notepad.exe", 1
89
+ Dim ws As Worksheet
48
90
 
49
- SendKeys "^v" '「Ctrl」＋「V」
91
+ Set ws = Worksheets.Add
50
92
 
51
- SendKeys "^s" '「Ctrl」＋「S」
93
+ ws.Name = "log"
52
94
 
53
- SendKeys "C:\Users\aaa\Desktop\α.txt " '保存先入力"
95
+
54
96
 
55
- SendKeys "{Enter}" 'ダイアログ ボックス確定"
97
+ 'コピー元を新シートに貼り付け
56
98
 
57
- SendKeys "%{F4}" '「Alt」＋「F4」
99
+ Range("A1").Select
58
100
 
59
- End If
101
+ ActiveSheet.paste
60
102
 
61
- End If
62
103
 
104
+
105
+ Dim datafile As String
106
+
107
+ datafile = ActiveWorkbook.Path & "\test(1).txt"
108
+
109
+
110
+
111
+ Open datafile For Output As #1
112
+
113
+
114
+
115
+ Dim i As Long
116
+
63
- End If
117
+ i = 1
118
+
119
+ Do While ws.Cells(i, 1).Value <> ""
120
+
121
+ Print #1, ws.Cells(i, 1).Value
122
+
123
+ i = i + 1
124
+
125
+ Loop
126
+
127
+
128
+
129
+ Close #1
130
+
131
+
132
+
133
+ MsgBox "test(1).txtに書き出しました"
134
+
135
+
64
136
 
65
137
  End Sub
138
+
139
+
66
140
 
67
141
  ```
68
142
 
@@ -72,11 +146,11 @@
72
146
 
73
147
 
74
148
 
75
- デスクトップじゃなくてパスを設定してそこに出力しようと考えましたが、
149
+ テキスト出力についてはセルA1にカーソルを合わせて全選択したら、
76
150
 
77
- ネットでは情報が多く、どれを見ていいかわかりませんでした。
151
+ 3行分しか選択できなかった。
78
152
 
79
-
153
+ 上記のソースコードだとシート内すべてをテキスト出力できないのか？
80
154
 
81
155
  ### 補足情報（FW/ツールのバージョンなど）
82
156