| |
▼学生 さん：
おはようございます。
指定されたブックの全シートのセルＡ１〜Ｊ１０の範囲のそれぞれのセルの合計値を
別ブックに集計表として作成しなさい という事でしょうか？
'======================================================================
Sub main()
Dim f_name As Variant
Dim check_book As Workbook
Dim rngadd As String
Dim save_book As Workbook
Dim savenm As Variant
Dim shtnm As Variant
'
f_name = Application.GetOpenFilename("(*.xls),*.xls", , "please select open-bookname")
If UCase(TypeName(f_name)) = UCase("boolean") Then Exit Sub
Set check_book = Workbooks.Open(f_name)
With check_book
rngadd = "[" & .Name & "]" & .Worksheets(1).Name & ":" & _
.Worksheets(.Worksheets.Count).Name & "!A1"
End With
savenm = Application.GetSaveAsFilename("", "(*.xls),*.xls", , "please input save-book-name")
If UCase(TypeName(savenm)) = UCase("boolean") Then Exit Sub
Application.SheetsInNewWorkbook = 1
Set save_book = Workbooks.Add
With save_book
With .Worksheets(1).Range("a1:j10")
.Formula = "=IF(counta(" & rngadd & ")-count(" & rngadd & ")>0,""No data"",SUM(" & rngadd & "))"
.Value = .Value
shtnm = Application.InputBox("please input sheet-name")
If UCase(TypeName(shtnm)) = UCase("boolean") Then
shtnm = "Summary"
End If
On Error Resume Next
.Parent.Name = shtnm
If Err.Number <> 0 Then .Parent.Name = "Summary"
On Error GoTo 0
End With
Application.DisplayAlerts = False
.SaveAs savenm
Application.DisplayAlerts = True
MsgBox "Ｔｏｔａｌ : " & Application.Sum(.Worksheets(1).Range("a1:j10"))
End With
save_book.Close False
check_book.Close False
End Sub
数値の数と文字の数は、出していませんから、考えてみて下さい。
（コード内でそれを計算する数式は使っています）
|
|
ichinose
- 05/6/3(金) 9:22 -
