初めての店舗開業を成功させよう>>

こんにちは。
今下記内容にて困っております。(画像にて困り事まとめました)
ご教示お願いいたします。
説明が不足しておりましたら、随時補足いたします。
(VBAベーシックを取得し、次にVBAスタンダード取得に向け勉強中のレベルです)

VBAにて、データファイル(Excel) を取り込み最大水量・総水量・判定した結果を指定したセルに貼り付けまた散布図・ヒストグラムを作成するVBA(下記コード参照。字数制限で内容の影響ない部分はカットしました)を作成しました。(Oiffce365にて作成中、使用する環境はOffice2016)
困っていることは、追加でVBAで新たなデータファイルを取り込み解析結果を
前の解析結果の下の空白枠に出力しようとして24行目でデバック(実行時エラー9 
インデックスが有効範囲にありません)が発生してしまいます。
またグラフも各解析結果のように前グラフの下の空白に張り付けていく方法はありますか。

コード全体
Sub ファイルを開く()

Dim Target As Variant
Dim Ret As String
Dim Fso As Object

Target = Application.GetOpenFilename("Excelブック,*.xl??")
If Target = "False" Then Exit Sub
Workbooks.Open Target



'Target = ActiveWorkbook.FullName

Set Fso = CreateObject("scripting.filesystemobject")
Ret = Fso.getbasename(Target)
Dim a As String

a = 35
ThisWorkbook.Activate
Do Until Sheet1.Range("E" & a) = ""
a = a + 2
Loop
Range("E" & a).Value = Ret

With Workbooks("???????.xlsm")

.Worksheets("sheet1").Range("E35") = Ret
.Worksheets("sheet1").Range("B69") = Ret
End With
MsgBox Target
Workbooks(Target).Activate →実行時エラー9 インデックスが有効範囲にありません
Sheets("sheet2").Select

Dim BeforePos As Long
Dim U As Variant
Dim U2 As Variant

BeforePos = Range("R6").End(xlDown).Row
Cells(BeforePos + 2, 22).Formula = "=MAX(R6:R" & BeforePos & ")"

U = Cells(BeforePos + 2, 22).Value

Workbooks("???????.xlsm").Worksheets("sheet1").Range("W35") = U

BeforePos = Range("R6").End(xlDown).Row
Cells(BeforePos + 3, 22).Formula = "=SUM(R6:R" & BeforePos & ")"
U2 = Cells(BeforePos + 3, 22).Value

Workbooks("???????.xlsm").Worksheets("sheet1").Range("AG35") = U2


If U < 2 Then
Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "?Z"
Else
Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "?~"

End If


Dim ThisSheet_Name As String
ThisSheet_Name = ActiveSheet.Name
With Charts.Add
.Location Where:=xlLocationAsObject, Name:=ThisSheet_Name
End With

ActiveChart.SeriesCollection.NewSeries '??????R?[?h???????G???[??????
With ActiveChart.SeriesCollection(1)
.ChartType = xlXYScatter '?U?z?}
.XValues = Range("A6", Range("A6").End(xlDown)) 'X??????????w??
.Values = Range("R6", Range("R6").End(xlDown))

End With

ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "????"

ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "????"


Dim ChartObj As Object '?????????Q?l
Set ChartObj = ActiveSheet.ChartObjects(1)


With ChartObj.Chart
.HasTitle = False
.HasLegend = False
'.ChartTitle.Text = Ret

End With

Dim tmp As Variant, I As Long
tmp = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Values
For I = 1 To UBound(tmp)
If tmp(I) >= 2 Then
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(I)
.Interior.ColorIndex = 3
.Interior.Pattern = xlSolid
End With
End If
Next I

With ChartObj
.Top = Range("B56").Top
.Left = Range("B56").Left
.Height = 234.425
.Width = 350.929 '????????

End With

ChartObj.Copy
Workbooks("???????.xlsm").Activate
Sheets("Sheet1").Select
Range("B71").Select
ActiveSheet.Paste



'?q?X?g?O????
Dim pvtChart As Shape

Workbooks(Ret + ".xlsx").Activate

ActiveSheet.Range("R6", Range("R6").End(xlDown)).Select

Set pvtChart = ActiveSheet.Shapes.AddChart2(366, xlHistogram)

'?O???t?^?C?g??
With pvtChart.Chart
.HasTitle = False

End With

「VBA 取り込みファイルデータの結果を順」の質問画像

質問者からの補足コメント

  • つらい・・・

    ご回答ありがとうございます。ご教示内容を元に項目・最大水量・総水量はうまくいきました。
    〇×判定が下記のようにしましたが、うまくいきません。ご教示いただければ幸いです。Dim d As String
    d = 35
    ThisWorkbook.Activate
    Do Until Sheet1.Range("AN" & d) = ""
    d = d + 2
    Loop
    'Range("AN" & d).Value = U2
    If U < 2 Then
    Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "?Z"
    Else
    Workbooks("???????.xlsm").Worksheets("sheet1").Range("AN35") = "?~"

    No.2の回答に寄せられた補足コメントです。 補足日時:2020/05/24 07:29
  • 献身的にご回答いただきありがとうございます。
    質問者のマナーが無くすいません。
    字数の制限の為、行き詰っているところを添付に記載しました。お手数ですがご確認いただけますか。
    説明不足でしたら補足しますのでよろしくお願いいたします。

    「VBA 取り込みファイルデータの結果を順」の補足画像2
      補足日時:2020/05/24 12:04
  • 下記がコードになります。
    '〇×判定
    Dim d As Variant
    d = 35
    ThisWorkbook.Activate
    Do Until Sheet1.Range("AN" & d) = ""
    d = d + 2
    Loop

    If U < 2 Then →Uは取り込みファイルの最大水量です。
    Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN35") = "〇"
    Else
    Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN35") = "×"
    End If
    Set wb = Workbooks.Open(Target)
    wb.Activate
    Sheets("sheet1").Select

      補足日時:2020/05/24 12:09
  • やりたい事
    一回目ごとにのデータファイルを取り込み
    項目・最大水量・総水量・判定をVBAにて解析していく。

    行き詰っている所
    項目・最大水量・総水量は空白に取り込んだファイル毎に
    解析結果が出力しますが、上記コードでは判定が空白のままになってしまします。

      補足日時:2020/05/24 12:13

A 回答 (5件)

No.2です。

補足コメント、ありがとうございます。
しかし、間違ったコードと「うまくいきません」だけでは、的を得た回答は出来かねます。
せめて、「どの行で」「どういったエラーが出るのか」を書いて頂けないと・・・。
(文法エラーなのか、実行時エラーなのか。それともエラーは発生しないが結果が想定と違う・・・等々)
それらを一括りにして「うまくいかない」っていう質問者が結構多いですが、回答側から見たら、「へっ?」って感じです。

提示のコードを見る限りで回答するならば・・・。

①変数dがStringで定義されているのに、加算している(結果としては問題なさそうだが)。

②>Do Until Sheet1.Range("AN" & d) = ""
Sheet1って何?
Worksheets("sheet1")の間違い?

③突然登場した変数U、U2の意味が分からないので、回答のしようが無い。
(「最初に提示されているコードを読め」ということであれば、お断りします)

④「Workbooks("???????.xlsm")」「"?Z"」等の「?」って何?文字化け?

まずは、この辺の見直し、および、補足をすべきでは?
(補足して頂いても回答を保証するものではありませんので、気に入らなければスルーしてください)
    • good
    • 0
この回答へのお礼

ママチャリさん
今回ご教示ありがとうございました。
VBAの内容しかり質問内容もしかり回答者に理解してもらえるように具体的に示せるように精進いたします。

お礼日時:2020/05/25 14:50

#4 失礼、


Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN" & d) =
です。申し訳ありません。
    • good
    • 0

>解析結果が出力しますが、上記コードでは判定が空白のままになってしまします。


If U < 2 Then →Uは取り込みファイルの最大水量です。
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN35") = "〇"
Else
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN35") = "×"
End If

すでに的確な指摘、回答もありますが、仮に
Do Until Sheet1.Range("AN" & d) = "" で
せっかく結合セルの行番号を抽出出来ても、反映されていませんね。
これでは同じ場所Range("AN35") に書き込まれてしまいます。

If U < 2 Then →Uは取り込みファイルの最大水量です。
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN & d") = "〇"
Else
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN & d") = "×"
End If
例として、このような感じになります。
初歩的なミスや見落としがあるようなので、コードを整理された方が良いように思いますよ。

ぱっと見、やばそうなコードをローカルに移してデバッグする気にはなりませんので。
    • good
    • 0
この回答へのお礼

'〇×判定
Dim d As String
d = 35
ThisWorkbook.Activate
Do Until Sheet1.Range("AN" & d) = ""
d = d + 2
Loop
If U < 2 Then
Range("AN" & d).Value = "〇"
Else
Range("AN" & d).Value = "×"
End If
動作いたしました。
ご教示ありがとうございます。
また全体を一度見直していいきます。

お礼日時:2020/05/25 14:43

Workbooks.Open Target



上記のコードでブックをオープンしているようですが、これを次のように変えるて、オープンと同時にブック名を変数に格納してみてはいかがでしょうか。以降、この変数でブックの特定ができるはずです。

「ブック名を格納する変数」 = Workbooks.Open(Target).Name

さらに言うと・・・。
「Workbooks(”ブック名”).~」って書き方は無粋です。
オープンした時点で、そのブックをオブジェクト変数に格納し、以降は、そのオブジェクト変数でブックを指定すべきです。
こんな感じです。

Set wb = Workbooks.Open(Target)


wb.Activate
この回答への補足あり
    • good
    • 0

http://officetanaka.net/excel/vba/filesystemobje …

こちらで拡張子も含んだファイル名を取得して『その変数名を』中に入れて上げたら宜しいのかも。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

このカテゴリの人気Q&Aランキング

おすすめ情報