質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

2回答

1197閲覧

処理時間を短くする方法はあるかご教授いただきたいです。

inoue-ryosuke-f

総合スコア2

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2021/12/16 10:36

約10万行と2列で構成されるデータのテキストファイルがあります。
そのテキストファイルの内容をコピーしてC、D列に貼り付けます。
そこから「グラフ開始時間」と「グラフ終了時間」に記載した範囲だけをF、G列に貼り付けます。
F列をx軸、G列をy軸として散布図を作っています。

データ自体が多いので仕方ないと思うのですが、それでも処理時間を短くする方法があればご教授いただきたいです!

イメージ説明

コードは以下の通りです。

VBA

1Sub sw_auto_graph() 2 3 4Dim last As Long 5Dim first_sw_s As Single 6Dim first_sw_l As Single 7Dim sec_sw_l As Single 8Dim sw_max_1 As Single 9Dim sw_max_2 As Single 10 11Dim Calstart As Single 12Dim Callast As Single 13Dim Graph As Variant 14 15 16 17 'セルのクリア 18 Dim wsActive As Worksheet 19 Set wsActive = ActiveSheet 20 Range(Cells(2, "C"), Cells(110000, "G")).Clear 21 22 23 Dim txtName As String 24 txtName = Application.GetOpenFilename("テキストファイル,*.txt") 25 26 If txtName <> "False" Then 27 Open txtName For Input As #1 28 End If 29 30 Dim r As Long 31 r = 1 '1行目から書き出す 32 33 Do Until EOF(1) 34 35 Dim buf As String 36 Line Input #1, buf 37 38 Dim aryLine As Variant '文字列格納用配列変数 39 aryLine = Split(buf, vbTab) '読み込んだ行をタブ区切りで配列変数に格納 40 41 Dim i As Long 42 For i = LBound(aryLine) To UBound(aryLine) 43 'インデックスが0から始まるので列番号に合わせるため+1 44 Cells(r + 1, i + 3) = aryLine(i) 45 Next 46 47 r = r + 1 48 49 Loop 50 51 Close #1 52 53 54 55 56start = 1 57last = Cells(Rows.Count, "C").End(xlUp).Row 58 59 60 61'衝撃波地点探査 62first_sw_s = Cells(10, "B").Value '第一衝撃波の開始点 63first_sw_l = Cells(12, "B").Value '第一衝撃波の終点 64sec_sw_l = Cells(14, "B").Value '第二衝撃波の終点 65 66For i = 2 To last 67 If Cells(i, "C").Value * 1000000 >= first_sw_s Then 68 s = i 69 Exit For 70 End If 71Next 72For i = s To last 73 If Cells(i, "C").Value * 1000000 >= first_sw_l Then 74 t = i 75 Exit For 76 End If 77Next 78For i = t To last 79 If Cells(i, "C").Value * 1000000 >= sec_sw_l Then 80 u = i 81 Exit For 82 End If 83Next 84 85'------------------------------------------------------------------------------------------------------ 86 87sw_max_1 = WorksheetFunction.Max(Range(Cells(s, "D"), Cells(t, "D"))) 88sw_max_2 = WorksheetFunction.Max(Range(Cells(t, "D"), Cells(u, "D"))) 89sw_min = WorksheetFunction.Min(Range(Cells(t, "D"), Cells(u, "D"))) 90Cells(17, "A").Value = sw_max_1 91Cells(19, "A").Value = sw_max_2 92Cells(21, "A").Value = sw_min 93 94For i = 2 To last 95 If Cells(i, "D").Value = sw_min Then 96 Cells(21, "B").Value = Cells(i, "C") * 1000000 97 End If 98Next 99For i = 2 To last 100 If Cells(i, "D").Value = sw_max_1 Then 101 Cells(17, "B").Value = Cells(i, "C") * 1000000 102 End If 103Next 104 105For i = 2 To last 106 If Cells(i, "D").Value = sw_max_2 Then 107 Cells(19, "B").Value = Cells(i, "C") * 1000000 108 End If 109Next 110 111'------------------------------------------------------------------------------------------------------ 112 113Calstart = Cells(6, "B").Value 114Callast = Cells(8, "B").Value 115 116If Callast > Cells(last, "C") * 1000000 Then 117MsgBox "グラフ終了時間が取得したデータの範囲外です。「終了」を押して値を減らしてください。" 118End If 119 120If Calstart < Cells(2, "C") * 1000000 Then 121MsgBox "グラフ開始時間が取得したデータの範囲外です。「終了」を押して値を増やしてください。" 122End If 123 124 125For i = 2 To last 126 If Cells(i, "C").Value * 1000000 >= Calstart Then 127 Calstart = i 128 Exit For 129 End If 130Next 131For k = Calstart To last 132 If Cells(k, "C").Value * 1000000 >= Callast Then 133 Callast = k 134 Exit For 135 End If 136Next 137 138n = Callast - Calstart 139j = 0 140 141ReDim Graph(n, 1) 142For h = Calstart To Callast 143Graph(j, 0) = Cells(h, "C").Value * 1000000 144Graph(j, 1) = Cells(h, "D").Value 145j = j + 1 146Next 147Range("F2").Resize(n + 1, 2) = Graph 148 149 150 ' グラフの位置 151 gpos_x = 300 152 gpos_y = 50 153 154 ' グラフのサイズ 155 g_width = 800 156 g_height = 300 157graph_name = "my_graph" 158 159y_offset = 2 160x_offset = 7 161series_num = 1 162chart_title = "Pressure" 163x_title = "Time[μs]" 164y_title = "Pressure[MPa]" 165 166 167 168 ' アクティブシート上に既存のグラフがあれば削除 169 If ActiveSheet.ChartObjects.Count > 0 Then 170 For i = 1 To ActiveSheet.ChartObjects.Count 171 ' グラフ名が一致するか 172 If ActiveSheet.ChartObjects(i).Name = graph_name Then 173 ActiveSheet.ChartObjects(i).Delete 174 Exit For 175 End If 176 Next i 177 End If 178 179 180 ' データ範囲を決定 (何行目まであるのか) 181 y_temp = y_offset 182 continue_flag = True 183 Do While continue_flag = True 184 ' この行に内容があれば次の行へ進む 185 If Len(Cells(y_temp, x_offset).Value) > 0 Then 186 y_temp = y_temp + 1 187 Else 188 continue_flag = False 189 End If 190 Loop 191 y_end = y_temp 192 x_end = x_offset + series_num - 1 193 194 195 196 Dim chartObj As ChartObject 197 Set chartObj = ActiveSheet.ChartObjects.Add( _ 198 gpos_x, gpos_y, g_width, g_height _ 199 ) 200 chartObj.Name = graph_name 201 With chartObj.Chart 202 203 ' データ範囲をセット(左上と右下) 204 .SetSourceData ActiveSheet.Range( _ 205 Cells(y_offset, x_offset), _ 206 Cells(y_end, x_end) _ 207 ), xlColumns 208 209 ' x軸の項目軸範囲をセット 210 .SeriesCollection(1).XValues = Range( _ 211 Cells(y_offset, x_offset - 1), _ 212 Cells(y_end, x_offset - 1) _ 213 ) 214 215 ' オプションをセット 216 .ChartType = xlXYScatter ' 散布図 217 .HasTitle = True 218 .ChartTitle.Characters.Text = chart_title 219 .Axes(xlcategory, xlPrimary).HasTitle = True 220 .Axes(xlcategory, xlPrimary).AxisTitle.Characters.Text = x_title 221 .Axes(xlValue, xlPrimary).HasTitle = True 222 .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = y_title 223 .Axes(xlcategory).MajorUnit = 5 224 .Axes(xlcategory).MinimumScale = Cells(6, "B").Value 225 .Axes(xlcategory).MaximumScale = Cells(8, "B").Value 226 227 228 229 230 231 End With 232 233 With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1) 234 .MarkerStyle = xlNone 'マーカーを非表示 235 236 End With 237 With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Format.Line 238 .DashStyle = msoLineSolid '実線にする 239 .Weight = 0.25 240 .ForeColor.RGB = RGB(0, 0, 255) 241 242 243 End With 244 245 ActiveSheet.ChartObjects(1).Chart.HasLegend = False 246 247ActiveSheet.ChartObjects(1).Chart.Axes(xlValue, 1).AxisTitle.Font.Color = RGB(0, 0, 0) '文字色 248ActiveSheet.ChartObjects(1).Chart.Axes(xlValue, 1).AxisTitle.Font.Size = 18 '文字サイズ 249 250ActiveSheet.ChartObjects(1).Chart.Axes(xlcategory, 1).AxisTitle.Font.Color = RGB(0, 0, 0) '文字色 251ActiveSheet.ChartObjects(1).Chart.Axes(xlcategory, 1).AxisTitle.Font.Size = 18 '文字サイズ 252 253 254Dim chtobj As Object 255 256For Each chtobj In ActiveSheet.ChartObjects 257 258 With chtobj.Chart.Axes(xlValue, xlPrimary) 259 .TickLabelPosition = xlLow 260 End With 261 262 With chtobj.Chart.Axes(xlcategory, xlPrimary) 263 .TickLabelPosition = xlLow 264 End With 265 266 267Next 268 269 270 271End Sub 272 273 274 275 276 277 278 279 280

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jinoji

2021/12/16 11:27

なかなかに長いコードですが、まずはどのあたりで時間が掛かっているか計測してみるのはどうですか?
inoue-ryosuke-f

2021/12/16 15:14

調べてみたところ、テキストファイルからコピーして貼り付けるところに時間がかかっていました(29秒) グラフの作成自体は7秒でした! 何かいい方法はないでしょうか?
guest

回答2

0

とりあえずこうするだけでも多少はマシになると思います。

VBA

1 'For i = LBound(aryLine) To UBound(aryLine) 2 ' Cells(r + 1, i + 3) = aryLine(i) 3 'Next 4 Cells(r + 1, 3).Resize(, UBound(aryLine) + 1) = aryLine 5

投稿2021/12/18 04:04

jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

セルに一個ずつデータを入れているので遅いのだと推測します。
行、列ともに1から始まる2次元配列を用意してそこにデータを保存していき最後にセルに代入した方が早いと思います。

VBA

1Dim v() as Variant 2Dim rowCount as Integer 3Dim columnCount as Integer 4'行列数を取得する処理をする 5Redim v(1 to rowCount, 1 to columnCount) '2次元配列を動的に確保 詳しくは「vba 2次元配列 redim」 などで検索してください。 6For row = 1 To rowCount 7 For col = 1 To columnCount 8 v(row, col) = 'データを代入 9 Next 10Next 11 12Dim ra as Range 13Set ra = Range("A1").Resize(rowCount, colCount) 'データを入れたいセル範囲を取得 14ra.Value = v '一気に入力

投稿2021/12/16 16:14

vann_2921

総合スコア190

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問