こんにちは。
今下記内容にて困っております。(画像にて困り事まとめました)
ご教示お願いいたします。
説明が不足しておりましたら、随時補足いたします。
(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
No.3ベストアンサー
- 回答日時:
No.2です。
補足コメント、ありがとうございます。しかし、間違ったコードと「うまくいきません」だけでは、的を得た回答は出来かねます。
せめて、「どの行で」「どういったエラーが出るのか」を書いて頂けないと・・・。
(文法エラーなのか、実行時エラーなのか。それともエラーは発生しないが結果が想定と違う・・・等々)
それらを一括りにして「うまくいかない」っていう質問者が結構多いですが、回答側から見たら、「へっ?」って感じです。
提示のコードを見る限りで回答するならば・・・。
①変数dがStringで定義されているのに、加算している(結果としては問題なさそうだが)。
②>Do Until Sheet1.Range("AN" & d) = ""
Sheet1って何?
Worksheets("sheet1")の間違い?
③突然登場した変数U、U2の意味が分からないので、回答のしようが無い。
(「最初に提示されているコードを読め」ということであれば、お断りします)
④「Workbooks("???????.xlsm")」「"?Z"」等の「?」って何?文字化け?
まずは、この辺の見直し、および、補足をすべきでは?
(補足して頂いても回答を保証するものではありませんので、気に入らなければスルーしてください)
ママチャリさん
今回ご教示ありがとうございました。
VBAの内容しかり質問内容もしかり回答者に理解してもらえるように具体的に示せるように精進いたします。
No.5
- 回答日時:
#4 失礼、
Workbooks("自動解析.xlsm").Worksheets("sheet1").Range("AN" & d) =
です。申し訳ありません。
No.4
- 回答日時:
>解析結果が出力しますが、上記コードでは判定が空白のままになってしまします。
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
例として、このような感じになります。
初歩的なミスや見落としがあるようなので、コードを整理された方が良いように思いますよ。
ぱっと見、やばそうなコードをローカルに移してデバッグする気にはなりませんので。
'〇×判定
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
動作いたしました。
ご教示ありがとうございます。
また全体を一度見直していいきます。
No.2
- 回答日時:
Workbooks.Open Target
上記のコードでブックをオープンしているようですが、これを次のように変えるて、オープンと同時にブック名を変数に格納してみてはいかがでしょうか。以降、この変数でブックの特定ができるはずです。
「ブック名を格納する変数」 = Workbooks.Open(Target).Name
さらに言うと・・・。
「Workbooks(”ブック名”).~」って書き方は無粋です。
オープンした時点で、そのブックをオブジェクト変数に格納し、以降は、そのオブジェクト変数でブックを指定すべきです。
こんな感じです。
Set wb = Workbooks.Open(Target)
・
・
wb.Activate
No.1
- 回答日時:
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ワイルドカード「*」を使うとう...
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
別ブックをダイアログボックス...
-
【ExcelVBA】インデックスが有...
-
VBA シート名が一致した場合の...
-
VBA コードを実行すると画面が...
-
Excel にて、 リストボックスの...
-
VBS Bookを閉じるコード
-
エクセル VBA 他シートの行を選...
-
[Excel]ADODBでNull変換されて...
-
任意のブックのシートをコピー
-
【VBA】全シートの計算式を全て...
-
VBA 実行時エラー 2147024893
-
VBA 別ブックからコピペしたい...
-
【マクロ】アクティブセルにブ...
-
【ExcelVBA】zip圧縮されたCSV...
-
EXCEL2013 シート内容を別ブッ...
-
vbaで他のブックに転記したい。...
-
複数のエクセルブックをひとつ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
VBA 別ブックからコピペしたい...
-
別ブックをダイアログボックス...
-
ワイルドカード「*」を使うとう...
-
【マクロ】AブックからBブック...
-
【ExcelVBA】インデックスが有...
-
【ExcelVBA】zip圧縮されたCSV...
-
VBA コードを実行すると画面が...
-
VBA シート名が一致した場合の...
-
VBA 実行時エラー 2147024893
-
VBS Bookを閉じるコード
-
VBAで別のブックにシートをコピ...
-
VBAで別ブックのシートを指定し...
-
【マクロ】違うフォルダにある...
-
[Excel]ADODBでNull変換されて...
-
VBAで複数のブックを開かずに処...
-
【Excel VBA】書き込み先ブック...
-
Excelマクロ 該当する値の行番...
-
vbaでvbaProjectのパスワード解...
おすすめ情報
ご回答ありがとうございます。ご教示内容を元に項目・最大水量・総水量はうまくいきました。
〇×判定が下記のようにしましたが、うまくいきません。ご教示いただければ幸いです。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") = "?~"
献身的にご回答いただきありがとうございます。
質問者のマナーが無くすいません。
字数の制限の為、行き詰っているところを添付に記載しました。お手数ですがご確認いただけますか。
説明不足でしたら補足しますのでよろしくお願いいたします。
下記がコードになります。
'〇×判定
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
やりたい事
一回目ごとにのデータファイルを取り込み
項目・最大水量・総水量・判定をVBAにて解析していく。
行き詰っている所
項目・最大水量・総水量は空白に取り込んだファイル毎に
解析結果が出力しますが、上記コードでは判定が空白のままになってしまします。