Visual Basicで困っています。教えてください。
1.以下のマクロを組みましたが、'計測値の合計を計算する がシートごとにできません。
それぞれのシートに合計をしたいのですが、どのように書けばよいのでしょうか。
worksheetfunction.sumを使用すればよいのかと思いましたがエラーとなってしまい困っています。
2.'平均値を計算して表示する で値が0の場合、0を除外した平均値を出したいのですが、if文などを使用すればよいのでしょうか。
VB詳しい方、ご教授下さい。
何卒よろしくお願い申し上げます。
以下マクロになります。文字制限の都合上2シート、2データとしています。
---------------------------------------------------------------------------------------------------
Sub Statistic()
'参照フォルダの選択
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
Range("f1").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
'フォルダの場所を変数に入れる
Dim Folder_path As String
Folder_path = Range("f1").Value
'集計するブックを変数に入れる
Dim Merge_book As String
Merge_book = Dir(Folder_path & "\*.xls*")
'新規ブックの作成
Workbooks.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "AC statistic"
Sheets(1).Range("A1:AA1").Columns.AutoFit
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "AB statistic"
Sheets(2).Range("A1:AA1").Columns.AutoFit
'集計先のシートを指定し、変数に入れる
Dim w
Set w = Worksheets("AC Statistic")
Dim x
Set x = Worksheets("AB Statistic")
Dim y
'集計先のシートの2行からスタート
Dim n
n = 2
'ラベルの記載
Sheets("AC Statistic").Select
ActiveCell.FormulaR1C1 = "file name"
Range("B1") = "Kuro"
Range("C1") = "Shiro"
Sheets("AB Statistic").Select
ActiveCell.FormulaR1C1 = "file name"
Range("B1") = "Kuro"
Range("C1") = "Shiro"
'指定したフォルダから、Excelファイルを探す
Do Until Merge_book = ""
Workbooks.Open Filename:=Folder_path & "\" & Merge_book
'見つかったら、A列にファイル名、B列以降にそれぞれの計測値を入れる
w.Range("a" & n).Value = Merge_book
w.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("AC Result").Range("K25").Value
w.Range("c" & n).Value = Workbooks(Merge_book).Worksheets("AC Result").Range("H3").Value
x.Range("a" & n).Value = Merge_book
x.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("AB Result").Range("K25").Value
x.Range("c" & n).Value = Workbooks(Merge_book).Worksheets("AB Result").Range("H3").Value
'次の行へ
n = n + 1
'集計するブックを閉じる
Workbooks(Merge_book).Close SaveChanges:=False
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'計測値の合計を計算する
Dim sumKuro, numKuro
Range("b2").Select
Do Until ActiveCell.Value = ""
numKuro = ActiveCell.Value
sumKuro = sumKuro + numKuro
ActiveCell.Offset(1, 0).Select
Loop
Dim sumShiro, numShiro
Range("c2").Select
Do Until ActiveCell.Value = ""
numShiro = ActiveCell.Value
sumShiro = sumShiro + numShiro
ActiveCell.Offset(1, 0).Select
Loop
'合計値を表示する
w.Range("A" & n + 2).Value = "sum"
w.Range("B" & n + 2).Value = sumKuro
w.Range("C" & n + 2).Value = sumShiro
x.Range("A" & n + 2).Value = "sum"
x.Range("B" & n + 2).Value = sumKuro
x.Range("C" & n + 2).Value = sumShiro
'平均値を計算して表示する
w.Range("A" & n + 3).Value = "Average"
w.Range("B" & n + 3).Value = sumKuro / (n - 2)
w.Range("C" & n + 3).Value = sumShiro/ (n - 2)
x.Range("A" & n + 3).Value = "Average"
x.Range("B" & n + 3).Value = sumKuro / (n - 2)
x.Range("C" & n + 3).Value = sumShiro / (n - 2)
'ファイルの保存。ファイルの保存場所と名前を指定
Application.Dialogs(xlDialogSaveAs).Show
End Sub
No.1
- 回答日時:
VBではなくVBAだと思いますが・・・
やりたい事についてシート構成の情報として読み取りにくい感じはしますけど?
どこにある何を計算してどうしたいのか、さっぱりです。
平均の分母が何故に『n - 2』(要は開いたBook数?)であるのかなどですかね。
No.2ベストアンサー
- 回答日時:
以下のようにしてください。
修正部はコメントを参照ください。
------------------------------------------------
Sub Statistic()
'参照フォルダの選択
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
Range("f1").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
'フォルダの場所を変数に入れる
Dim Folder_path As String
Folder_path = Range("f1").Value
'集計するブックを変数に入れる
Dim Merge_book As String
Merge_book = Dir(Folder_path & "\*.xls*")
'新規ブックの作成
Workbooks.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "AC statistic"
Sheets(1).Range("A1:AA1").Columns.AutoFit
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "AB statistic"
Sheets(2).Range("A1:AA1").Columns.AutoFit
'集計先のシートを指定し、変数に入れる
Dim w
Set w = Worksheets("AC Statistic")
Dim x
Set x = Worksheets("AB Statistic")
Dim y
'集計先のシートの2行からスタート
Dim n
n = 2
'ラベルの記載
Sheets("AC Statistic").Select
ActiveCell.FormulaR1C1 = "file name"
Range("B1") = "Kuro"
Range("C1") = "Shiro"
Sheets("AB Statistic").Select
ActiveCell.FormulaR1C1 = "file name"
Range("B1") = "Kuro"
Range("C1") = "Shiro"
'指定したフォルダから、Excelファイルを探す
Do Until Merge_book = ""
Workbooks.Open Filename:=Folder_path & "\" & Merge_book
'見つかったら、A列にファイル名、B列以降にそれぞれの計測値を入れる
w.Range("a" & n).Value = Merge_book
w.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("AC Result").Range("K25").Value
w.Range("c" & n).Value = Workbooks(Merge_book).Worksheets("AC Result").Range("H3").Value
x.Range("a" & n).Value = Merge_book
x.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("AB Result").Range("K25").Value
x.Range("c" & n).Value = Workbooks(Merge_book).Worksheets("AB Result").Range("H3").Value
'次の行へ
n = n + 1
'集計するブックを閉じる
Workbooks(Merge_book).Close SaveChanges:=False
'次のファイルを探しに行く
Merge_book = Dir()
Loop
'計測値の合計を計算する
'-------------ここから修正開始---------------
Dim ws_array As Variant
Dim ws As Worksheet
Dim sumKuro, numKuro
Dim sumShiro, numShiro
Dim i As Long
Dim row As Long
ws_array = Array("AC Statistic", "AB Statistic")
For i = 0 To UBound(ws_array)
Set ws = Worksheets(ws_array(i))
sumKuro = 0
numKuro = 0
sumShiro = 0
numShiro = 0
For row = 2 To n - 1
If ws.Cells(row, 2).Value <> 0 Then
numKuro = numKuro + 1
sumKuro = sumKuro + ws.Cells(row, 2).Value
End If
If ws.Cells(row, 3).Value <> 0 Then
numShiro = numShiro + 1
sumShiro = sumShiro + ws.Cells(row, 3).Value
End If
Next
'合計値を表示する
ws.Range("A" & n + 2).Value = "sum"
ws.Range("B" & n + 2).Value = sumKuro
ws.Range("C" & n + 2).Value = sumShiro
'平均値を計算して表示する
ws.Range("A" & n + 3).Value = "Average"
If numKuro = 0 Then
ws.Range("B" & n + 3).Value = 0
Else
ws.Range("B" & n + 3).Value = sumKuro / numKuro
End If
If numShiro = 0 Then
ws.Range("C" & n + 3).Value = 0
Else
ws.Range("C" & n + 3).Value = sumShiro / numShiro
End If
Next
'-------------ここまで修正終了---------------
'ファイルの保存。ファイルの保存場所と名前を指定
Application.Dialogs(xlDialogSaveAs).Show
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) 配列の勉強をしています。使用する変数の意味、検索条件の書き方が難しいです。 2 2022/09/15 14:06
- Visual Basic(VBA) フォルダの場所を可変にしたいです(マクロ) 4 2023/05/11 10:00
- Visual Basic(VBA) VBAコードを張り付け後のエクセルの進め方 2 2023/02/07 18:24
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 4 2023/05/26 10:43
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
【ExcelVBA】zip圧縮されたCSV...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
ワイルドカード「*」を使うとう...
-
【困っています2】VBA 追加処...
-
VBA シート名が一致した場合の...
-
EXCEL VBA 単語置き換え につい...
-
ExcelのVBAです。フォルダ内の...
-
エクセル VBA 他シートの行を選...
-
エクセルVBAで書式と値の貼付け...
-
VBA 別ブックからコピペしたい...
-
VBS Bookを閉じるコード
-
マクロで最終行を取得したい
-
【前回の続き続きです、ご教示...
-
クリップボードに貼付している...
-
Excel-VBAでのファイルの開き方
-
VBAで別ブックのシートを指定し...
-
【マクロ】違うフォルダにある...
-
VBSでExcelのオープン確認
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
別ブックをダイアログボックス...
-
ワイルドカード「*」を使うとう...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
VBS Bookを閉じるコード
-
【ExcelVBA】インデックスが有...
-
VBA コードを実行すると画面が...
-
【ExcelVBA】zip圧縮されたCSV...
-
vbaでvbaProjectのパスワード解...
-
VBAで別ブックのシートを指定し...
-
ExcelのVBAです。フォルダ内の...
-
vbaで他のブックに転記したい。...
-
フォルダ内の全てのファイルに...
-
VBAで複数のブックを開かずに処...
-
VBSでExcelのオープン確認
-
VBA 実行時エラー 2147024893
-
【Excel VBA】書き込み先ブック...
-
VBA シート名が一致した場合の...
おすすめ情報