ホーム>source

新しいワークシートを生成する次のコードがあります。新しいワークシートに、フレーズ、セル1の内容、セル2の日付を使用して名前を付けようとしています。 セル1には、データ検証(合計4つのオプション)を介して挿入されるいくつかのデータが含まれ、セル2には日付が含まれます。

例: ワークシート入力範囲C3。セル1の値=貿易活動、購入、販売など

ワークシート入力範囲C2。セル2の値= 2.11.2020

新しいワークブックの名前は「Client Name Trade Activities-2.11.2020」になります。

セル1とセル2の両方がINPUTSワークシートにあります

<前>ウィズウィズ Private Sub CommandButton1_Click() Dim targetWorkbook As Workbook Dim sourceSheet As Worksheet Dim formatDate As String Dim fileName As String Set sourceSheet = ThisWorkbook.Worksheets("Sheet1") If sourceSheet.AutoFilterMode Then sourceSheet.AutoFilterMode = False If ThisWorkbook.Worksheets("INPUTS").Range("C3").Value <> vbNullString Then formatDate = Format(Sheets("INPUTS").Range("C3"), "YYYY.MM.DD") End If fileName = "Name - " & ActivityName & formatDate sourceSheet.Outline.ShowLevels ColumnLevels:=1 sourceSheet.Range("A:M").AutoFilter Field:=12, Criteria1:="<>0" Set targetWorkbook = Workbooks.Add sourceSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy targetWorkbook.Worksheets(targetWorkbook.Sheets.Count).Range("A1") targetWorkbook.Sheets("sheet1").Columns("A:AC").EntireColumn.AutoFit targetWorkbook.SaveAs ThisWorkbook.Path & "\" & fileName & ".xlsx", FileFormat:=51 End Sub
あなたの答え
  • 解決した方法 # 1

    覚えておくべきこと:

    できる限り変数を定義して再利用する

    コードにコメントを追加して、何をしているかの目的を説明してください(将来の自分や、ファイルを操作する人に感謝します)

    コードの主要部分の間にスペースを入れて、読みやすくします

    編集: 既存のファイルの上書きを要求するときにユーザーが[いいえ]をクリックした場合のエラーハンドラーを追加しました

    コード:

    <前>ウィズウィズ

    うまくいくか教えてください

    Private Sub CommandButton1_Click() Dim targetWorkbook As Workbook Dim sourceSheet As Worksheet Dim formatDate As String Dim fileName As String On Error GoTo CleanFail Set sourceSheet = ThisWorkbook.Worksheets("Sheet1") ' Remove filter If sourceSheet.AutoFilterMode Then sourceSheet.AutoFilterMode = False If sourceSheet.Range("F1").Value <> vbNullString Then formatDate = Format(sourceSheet.Range("F1").Value, "YYYY.MM.DD") End If ' Set the new workbook file name fileName = "NAME - " & formatDate ' Filter the fileNames sourceSheet.Range("A:C").AutoFilter Field:=2, Criteria1:="<>" ' Add new workbook and set reference Set targetWorkbook = Workbooks.Add ' Copy the visible fileNames in a new workbook sourceSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy targetWorkbook.Worksheets(targetWorkbook.Sheets.Count).Range("A1") ' Save the new workbook targetWorkbook.SaveAs ThisWorkbook.Path & "\" & fileName & ".csv", FileFormat:=xlCSV CleanExit: Exit Sub CleanFail: Select Case Err.Number Case 1004 MsgBox "You cancel the process" Resume Next Case Else ' Do something else? handle it properly... MsgBox "Something went wrong..." Resume CleanExit End Select End Sub

  • 前へ java - JPAクエリ:サブクエリをグループ化条件に結合する
  • 次へ angular - Mat-Selectで選択したオプションを非表示