アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

A 回答 (2件)

VBではなくVBAだと思いますが・・・



やりたい事についてシート構成の情報として読み取りにくい感じはしますけど?
どこにある何を計算してどうしたいのか、さっぱりです。
平均の分母が何故に『n - 2』(要は開いたBook数?)であるのかなどですかね。
    • good
    • 0
この回答へのお礼

読み取りにくい質問ですみません。コメントありがとうございました。

お礼日時:2018/03/06 12:05

以下のようにしてください。


修正部はコメントを参照ください。
------------------------------------------------
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
    • good
    • 0
この回答へのお礼

コメントありがとうございました!無事に動かすことができるようになりました。

お礼日時:2018/03/06 12:03

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