列の値を合計し、その合計をワークブックのファイル名に追加します。

Question

こんにちは。列内の一意の値に基づいて新しいワークシートを作成することができました。これに加えて、列内の値を合計し、この合計を各対応するワークシートのファイル名に含めたいと思います。

列 D の値の合計を、Filename_Sum(D).xls の形式でこのワークブックのファイル名に追加します。

これは私がやったことです。必要なのは、列 I2:I の合計を計算し、その合計を文字列に変換してファイル名に含めることだけです (列 A の値)

            'Copy/paste the visible data to the new workbook
            My_Range.SpecialCells(xlCellTypeVisible).Copy
            With WSNew.Range("A1")
                ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
                ' Remove this line if you use Excel 97
                .PasteSpecial Paste:=8
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
                .Select                  

            End With

            mySum = Application.WorksheetFunction.Sum(Columns("I2:I1024"))


            'Save the file in the new folder and close it
            On Error Resume Next
            WSNew.Parent.SaveAs foldername & _
                                cell.Value _
                                & CStr(mySum) & _
                                FileExtStr, FileFormatNum'

Answer 1

VBA やマクロについて何も知らないと仮定して、目的を達成するための最短の手順を以下に示します。

ワークブックを開きます。キーボードで、Alt + F11 キーを押します。これで VBA 開発者画面が開きます。左側にツリーがあります。一番上のオブジェクト (VBAProject(YourFileName)) を右クリックし、[挿入] > [モジュール] を選択します。開いたモジュールのメイン画面に次のコードを貼り付けます。

Option Explicit
Sub SaveWithSum()
Dim SumOfD As Integer
SumOfD = Application.Sum(Range("Sheet1!D:D"))
ActiveWorkbook.SaveAs "C:\YourFolder\YourFilename" & SumOfD & ".xlsx", FileFormat:=51
End Sub

次に、「保存」をクリックします。現在のファイル形式 (.xlsx) でマクロを実行できるかどうかの確認メッセージが表示されます。「いいえ」を選択し、ファイルを YourFile.xlsm として保存します。

完了です。結果のファイルは C:\YourFolder\YourFilename##.xlsx になります。

このスクリプトは、名前が変更されたすべてのファイルを .xlsx ファイルとして保存しますが、マクロを再度実行することはできません (実際には開発者画面から消えます)。ファイルを .xlsm ファイルとして保存し、保存したファイルでもスクリプトを引き続き実行する場合は、「.xslx」を「.xlsm」に変更し、FileFormat を 52 に変更します。

ワークシート上にマクロにリンクするボタンを作成することもできます (簡単な Google 検索が役立ちます)。または、[表示] > [マクロ] を選択してそこからマクロを実行することもできます。

Sheet1! がワークシートと一致するように変更されていることを確認してください。幸運を祈ります!

Answer 2

この質問は数年前に投稿されたものですが、解決策を探している他の人のために回答を提供したいと思います。

Sub save_with_value()

Dim Fname As String
Dim cell As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False         'replaces existing file if already exists

Fpath = "O:\TEST\Values\"  'folder path - change accordingly to your folder
Fname = »Filename« 
Dim result As Double
result = WorksheetFunction.Sum(Range("D:D")) 
ActiveWorkbook.SaveAs Filename:= _
        Fpath & "\" & Fname & "_" & Format(result, "#,##0.00") & " EUR" & ".xlsx"

End sub