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

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

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

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

マクロ

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

受付中

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

inoue-ryosuke-f
inoue-ryosuke-f

総合スコア2

VBA

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

マクロ

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

2回答

0評価

0クリップ

429閲覧

投稿2021/12/16 10:36

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

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

イメージ説明

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

VBA

Sub sw_auto_graph() Dim last As Long Dim first_sw_s As Single Dim first_sw_l As Single Dim sec_sw_l As Single Dim sw_max_1 As Single Dim sw_max_2 As Single Dim Calstart As Single Dim Callast As Single Dim Graph As Variant 'セルのクリア Dim wsActive As Worksheet Set wsActive = ActiveSheet Range(Cells(2, "C"), Cells(110000, "G")).Clear Dim txtName As String txtName = Application.GetOpenFilename("テキストファイル,*.txt") If txtName <> "False" Then Open txtName For Input As #1 End If Dim r As Long r = 1 '1行目から書き出す Do Until EOF(1) Dim buf As String Line Input #1, buf Dim aryLine As Variant '文字列格納用配列変数 aryLine = Split(buf, vbTab) '読み込んだ行をタブ区切りで配列変数に格納 Dim i As Long For i = LBound(aryLine) To UBound(aryLine) 'インデックスが0から始まるので列番号に合わせるため+1 Cells(r + 1, i + 3) = aryLine(i) Next r = r + 1 Loop Close #1 start = 1 last = Cells(Rows.Count, "C").End(xlUp).Row '衝撃波地点探査 first_sw_s = Cells(10, "B").Value '第一衝撃波の開始点 first_sw_l = Cells(12, "B").Value '第一衝撃波の終点 sec_sw_l = Cells(14, "B").Value '第二衝撃波の終点 For i = 2 To last If Cells(i, "C").Value * 1000000 >= first_sw_s Then s = i Exit For End If Next For i = s To last If Cells(i, "C").Value * 1000000 >= first_sw_l Then t = i Exit For End If Next For i = t To last If Cells(i, "C").Value * 1000000 >= sec_sw_l Then u = i Exit For End If Next '------------------------------------------------------------------------------------------------------ sw_max_1 = WorksheetFunction.Max(Range(Cells(s, "D"), Cells(t, "D"))) sw_max_2 = WorksheetFunction.Max(Range(Cells(t, "D"), Cells(u, "D"))) sw_min = WorksheetFunction.Min(Range(Cells(t, "D"), Cells(u, "D"))) Cells(17, "A").Value = sw_max_1 Cells(19, "A").Value = sw_max_2 Cells(21, "A").Value = sw_min For i = 2 To last If Cells(i, "D").Value = sw_min Then Cells(21, "B").Value = Cells(i, "C") * 1000000 End If Next For i = 2 To last If Cells(i, "D").Value = sw_max_1 Then Cells(17, "B").Value = Cells(i, "C") * 1000000 End If Next For i = 2 To last If Cells(i, "D").Value = sw_max_2 Then Cells(19, "B").Value = Cells(i, "C") * 1000000 End If Next '------------------------------------------------------------------------------------------------------ Calstart = Cells(6, "B").Value Callast = Cells(8, "B").Value If Callast > Cells(last, "C") * 1000000 Then MsgBox "グラフ終了時間が取得したデータの範囲外です。「終了」を押して値を減らしてください。" End If If Calstart < Cells(2, "C") * 1000000 Then MsgBox "グラフ開始時間が取得したデータの範囲外です。「終了」を押して値を増やしてください。" End If For i = 2 To last If Cells(i, "C").Value * 1000000 >= Calstart Then Calstart = i Exit For End If Next For k = Calstart To last If Cells(k, "C").Value * 1000000 >= Callast Then Callast = k Exit For End If Next n = Callast - Calstart j = 0 ReDim Graph(n, 1) For h = Calstart To Callast Graph(j, 0) = Cells(h, "C").Value * 1000000 Graph(j, 1) = Cells(h, "D").Value j = j + 1 Next Range("F2").Resize(n + 1, 2) = Graph ' グラフの位置 gpos_x = 300 gpos_y = 50 ' グラフのサイズ g_width = 800 g_height = 300 graph_name = "my_graph" y_offset = 2 x_offset = 7 series_num = 1 chart_title = "Pressure" x_title = "Time[μs]" y_title = "Pressure[MPa]" ' アクティブシート上に既存のグラフがあれば削除 If ActiveSheet.ChartObjects.Count > 0 Then For i = 1 To ActiveSheet.ChartObjects.Count ' グラフ名が一致するか If ActiveSheet.ChartObjects(i).Name = graph_name Then ActiveSheet.ChartObjects(i).Delete Exit For End If Next i End If ' データ範囲を決定 (何行目まであるのか) y_temp = y_offset continue_flag = True Do While continue_flag = True ' この行に内容があれば次の行へ進む If Len(Cells(y_temp, x_offset).Value) > 0 Then y_temp = y_temp + 1 Else continue_flag = False End If Loop y_end = y_temp x_end = x_offset + series_num - 1 Dim chartObj As ChartObject Set chartObj = ActiveSheet.ChartObjects.Add( _ gpos_x, gpos_y, g_width, g_height _ ) chartObj.Name = graph_name With chartObj.Chart ' データ範囲をセット(左上と右下) .SetSourceData ActiveSheet.Range( _ Cells(y_offset, x_offset), _ Cells(y_end, x_end) _ ), xlColumns ' x軸の項目軸範囲をセット .SeriesCollection(1).XValues = Range( _ Cells(y_offset, x_offset - 1), _ Cells(y_end, x_offset - 1) _ ) ' オプションをセット .ChartType = xlXYScatter ' 散布図 .HasTitle = True .ChartTitle.Characters.Text = chart_title .Axes(xlcategory, xlPrimary).HasTitle = True .Axes(xlcategory, xlPrimary).AxisTitle.Characters.Text = x_title .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = y_title .Axes(xlcategory).MajorUnit = 5 .Axes(xlcategory).MinimumScale = Cells(6, "B").Value .Axes(xlcategory).MaximumScale = Cells(8, "B").Value End With With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1) .MarkerStyle = xlNone 'マーカーを非表示 End With With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Format.Line .DashStyle = msoLineSolid '実線にする .Weight = 0.25 .ForeColor.RGB = RGB(0, 0, 255) End With ActiveSheet.ChartObjects(1).Chart.HasLegend = False ActiveSheet.ChartObjects(1).Chart.Axes(xlValue, 1).AxisTitle.Font.Color = RGB(0, 0, 0) '文字色 ActiveSheet.ChartObjects(1).Chart.Axes(xlValue, 1).AxisTitle.Font.Size = 18 '文字サイズ ActiveSheet.ChartObjects(1).Chart.Axes(xlcategory, 1).AxisTitle.Font.Color = RGB(0, 0, 0) '文字色 ActiveSheet.ChartObjects(1).Chart.Axes(xlcategory, 1).AxisTitle.Font.Size = 18 '文字サイズ Dim chtobj As Object For Each chtobj In ActiveSheet.ChartObjects With chtobj.Chart.Axes(xlValue, xlPrimary) .TickLabelPosition = xlLow End With With chtobj.Chart.Axes(xlcategory, xlPrimary) .TickLabelPosition = xlLow End With Next End Sub

良い質問の評価を上げる

以下のような質問は評価を上げましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

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

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

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

teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

  • プログラミングに関係のない質問
  • やってほしいことだけを記載した丸投げの質問
  • 問題・課題が含まれていない質問
  • 意図的に内容が抹消された質問
  • 過去に投稿した質問と同じ内容の質問
  • 広告と受け取られるような投稿

評価を下げると、トップページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

jinoji

2021/12/16 11:27

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

2021/12/16 15:14

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

まだ回答がついていません

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

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

ただいまの回答率
87.20%

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

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

質問する

関連した質問

同じタグがついた質問を見る

VBA

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

マクロ

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