Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


74877 / 76732 ←次へ | 前へ→

【6308】ありがとうございます。でもうまくいきません。もう一度教えて下さい。
質問  TARO  - 03/6/23(月) 15:07 -

引用なし
パスワード
    まず最初にKeinさん、どうもありがとうございます。
多分Keinさんの方法で正しいのだと思うのですが、どうしてもうまく組めません。
本当にあつかましいのですが、マクロとデータを見て再度教えていただけませんか?
ごめんなさい。でもお願いします。

このマクロだと、6月3日と6月10日の横軸、縦軸が変更されていないのと
横軸目盛数値はストレイン値になっているのに、縦軸目盛数値は深度になっていません。
また6月3日と6月10日以外は、縦軸、横軸変更はされているような形なのですが、
各深度で作図されていません。規則性がつかめません。

<マクロ>
  Dim inname
  Dim outname
  Dim WS     As Worksheet
  Dim myRange   As Range
  Dim ix1     As Integer
  Dim ix2     As Integer
  Dim ix3     As Integer
  Dim ix1max   As Integer
  Dim vbnm    As Variant
  Dim maxgyo   As Long
  Dim maxretu   As Long
  
  Dim RUISA    As Worksheet       '累計差
  Dim TATERUISA  As Worksheet       '縦累計差

中略

Sub exlread()
  Dim genbanm   As Variant
  Dim year    As Integer
  Dim blocknm   As Variant
  Dim el(100)   As Single
  Dim yymm    As Date
  Dim data(100, 100) As Long
  
  Dim gyo     As Integer
  Dim retu    As Integer
  Dim sheetno   As Integer
  Dim OBJ     As Worksheet

'  ------------>  シートの数だけ処理
  ix1 = 1
  ix1max = Worksheets.Count
  MsgBox "シート総枚数 = " & ix1max
  
  Do While ix1 <= ix1max
'  新シート作成()
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    ix2 = Worksheets.Count
    Sheets(ix2).Select
    Set RUISA = Workbooks(Dir(inname)).ActiveSheet

    Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
    ix3 = Worksheets.Count
    Sheets(ix3).Select
    Set TATERUISA = Workbooks(Dir(inname)).ActiveSheet
    
    Sheets(ix1).Select
    Set OBJ = Workbooks(Dir(inname)).ActiveSheet
'  ------------>  シート入力済み最終行を得る(=maxgyo)
    maxgyo = Range("A1").CurrentRegion.Rows.Count
    maxretu = Range("A1").CurrentRegion.Columns.Count
'
'  ---------------------------------------------->   データ加工処理
'
'  ------------>  シート固定ヘッダー部
    genbanm = OBJ.Cells(1, 2)
    year = OBJ.Cells(2, 2)
    blocknm = OBJ.Cells(3, 2)
    vbnm = OBJ.Cells(4, 2)

    retu = 2
'  ------------>  最終列迄処理
    Do While retu <= maxretu
      gyo = 6
'  ------------>  最終行迄処理
      Do While gyo <= maxgyo
        If IsNumeric(OBJ.Cells(gyo, retu)) = True Then
         data(gyo, retu) = OBJ.Cells(gyo, retu)
         If data(gyo, retu) = 99999 Then
         data(gyo, retu) = data(gyo, (retu - 1))
         End If
        End If
        gyo = gyo + 1
      Loop            '1列の処理END
    retu = retu + 1
    Loop              '1シート終了
'
'  ------------------------------------------->   累差計算処理
'以下処理はシート上のどこかに数値が無いとグラフが書けないのだと思い作成しました。

    retu = 3
'  ------------>  最終列迄処理
    Do While retu <= maxretu
      RUISA.Cells(5, retu) = OBJ.Cells(5, retu)
      RUISA.Cells(5, retu).NumberFormatLocal = "m""月""d""日"""
      gyo = 6
'  ------------>  最終行迄処理
      Do While gyo <= maxgyo
        RUISA.Cells(gyo, 2) = OBJ.Cells(gyo, 1)
        RUISA.Cells(gyo, retu) = (data(gyo, retu) - data(gyo, 2))
        gyo = gyo + 1
      Loop            '1列の処理END
'    MsgBox "行条件パス " & gyo
    retu = retu + 1
    Loop              '1シート終了

'  -------------->   グラフ作成
  graph1draw

  ix1 = ix1 + 1            '1シート処理終了
  Loop                'Do While ix1 <= ix1max

End Sub

Function graph1draw()
  Dim XV As Variant, V As Variant
  Dim ix4   As Integer
 
  Sheets(ix2).Select

'  ------------>  シート最終行を得る(=maxgyo)
  maxgyo = Range("B6").CurrentRegion.Rows.Count
  maxretu = Range("B6").CurrentRegion.Columns.Count
  
  Set GRP1 = ActiveSheet.ChartObjects.Add(0, 0, 500, 400)
  GRP1.Chart.SetSourceData _
    Source:=ActiveSheet.Range(Cells(Range("B65536").End(xlUp).Row, Range("IV5").End(xlToLeft).Column), _
    Cells(Range("C1").End(xlDown).Row, Range("A6").End(xlToRight).Column)), PlotBy:=xlColumns
  GRP1.Chart.ChartType = xlXYScatterLines

  ix4 = 3
  Do While ix4 < (maxretu - 1)
    With GRP1.Chart.SeriesCollection(ix4)
      XV = .XValues
      V = .Values
      .XValues = V
      .Values = XV
    End With
    ix4 = ix4 + 1
  Loop

  With GRP1.Chart
    .HasTitle = True
    .ChartTitle.Characters.Text = vbnm & "  歪 変 動 図"
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "ストレイン"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "深度"
  End With
  With GRP1.Chart.Axes(xlCategory)
    .HasMajorGridlines = True
    .HasMinorGridlines = False
  End With
  With GRP1.Chart.Axes(xlValue)
    .HasMajorGridlines = True
    .HasMinorGridlines = False
  End With
  GRP1.Chart.HasDataTable = False

End Function

<データ>
カラムがあってなくてごめんなさい。
   A    B     C     D     E      F      G               
1
2
3
4
5        5月20日    5月27日    6月3日    6月10日    6月17日
6    1    -180     -100    -150    -170    -130
7    2    30      40    40     30     10
8    3    -80      -60    -90    -90     -60
9    4    -20      -20    30        -20     -10
10    5    -50      20    -50    -50     -40
11    6    -150      -70    -80    -100     -80
12    7    -120     -120    -30    -100     -40
13    8    30     30    20      0     10
14    9    -180   -170    -130    -270    -150
15    10    50     -20    -50    -30     -60
16    11    -170   -280    -30    -40     -10
17    12    270    270    180    -80     -80
18    13    -140   -140    -130    -70    -160
19    14    -130   -100    -100    -110     -90
20    15    -270   -300    -200    -230    -230
21    16    -230   -250    -170    -290    -220
22    17      0     0      0     0      0
23    18    -260   -250    -250    -300    -260
24    19    210    210    210     220     250
25    20    -20    -30    -30     -40     -30
26    21    120     70    130     130     150
27    22    -210   -190    -220   -170    -190
28    23    30     70    80     60     120
29    24    650    720    470     420    470
30    25    -40    180    270     290    300
31    26    30     10        20      0     30
32    27    0     -10       -30    -30     -30
33    28    230    250       280    230    230
34    29    910    930       940    860    980
35    30    -30     0       -10    0    10
36    31    3600   3690       3620    3570    3640
37    32    -1870  -1810      -1830    -1870    -1810
38    33    -160   -120       -130    -120    -130
39    34    -1300  -1350      -1310    -1300    -1300
40    35    -1180     -1280      -1280    -1280    -1280
    深度(B)  ストレイン(C)→

これだけの情報でわかっていただけるでしょうか?不足があれば言って下さい。
長々とすいません。どうかお願いいたします。
0 hits

【6226】グラフの系列の変更指定がわかりません TARO 03/6/19(木) 16:02 質問
【6265】Re:グラフの系列の変更指定がわかりません Kein 03/6/21(土) 17:33 回答
【6308】ありがとうございます。でもうまくいきませ... TARO 03/6/23(月) 15:07 質問
【6332】うまくいきました。ありがとうございました。 TARO 03/6/24(火) 17:54 お礼

74877 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free