Excelで表を使った顧客管理ソフトを作ってみよう

Step 9 抽出結果を別のシートにコピー

抽出ユーザーフォームに「結果をコピー」ボタンを追加しています。

抽出結果のコピーは下記の流れで行っています。
1)抽出結果のデータがあるかどうかチェックします。
  なければメッセージを表示し終了します。
2)最後のシートの後ろに新規シートを追加します。
3)先頭に「抽出結果」と付くシートがあるかチェックします。
  なければ、1を返します。
  見つかれば、「抽出結果」の後の数値を抜き出し+1し返します。
4)追加したシート名を「抽出結果」プラス先ほど取得した数値の名前に変更します。
5)見出しと抽出結果のデータをコピーします。
6)列幅を「顧客一覧」シートと同じにします。


Homeへ > Excelでアプリケーションソフト2 > 顧客管理ソフトを作ってみよう

シートのVBAコード

下記のVBAコードを追加してください。

Private Function ExSheetNameMake() As String
    Dim tsheet As Object
    Dim ln As Long
    Dim lmax As Long
    Dim s1 As String
    
    lmax = 0
    For Each tsheet In ActiveWorkbook.Worksheets
        If Left(tsheet.Name, 4) = "抽出結果" Then
            s1 = Mid(tsheet.Name, 5, Len(tsheet.Name))
On Error Resume Next
            If s1 <> "" Then
                ln = Val(s1)
                If ln > lmax Then
                    lmax = ln
                End If
            End If
        End If
    Next
    ExSheetNameMake = ln + 1
End Function

Private Sub CommandButton4_Click()
    Dim sname As String
    Dim destsheet As Object
    Dim filarea As Object
    Dim ln As Long
    Dim i As Integer
    Dim s1 As String
    
   Set filarea = Worksheets("顧客一覧").Range("A4").CurrentRegion
    ln = filarea.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
    If ln = 0 Then
        MsgBox "コピーするデータがありません。"
        Exit Sub
    End If
    
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    s1 = ExSheetNameMake
    Worksheets(Worksheets.Count).Name = "抽出結果" & s1
    sname = Worksheets(Worksheets.Count).Name
    
    filarea.Resize(filarea.Rows.Count - 1).Offset(0).Copy Destination:=Worksheets(sname).Range("A4")
    Worksheets("顧客一覧").Select

    For i = 1 To 12
        Worksheets(sname).Cells(1, i).ColumnWidth = Worksheets("顧客一覧").Cells(1, i).ColumnWidth
    Next
End Sub



抽出画面

■抽出実行画面
「部署名」から「販売」で抽出しています。
部署名で抽出

■結果をコピー後
「抽出結果1」のシートが作成され、抽出結果がコピーされています。
最後にシートを追加しコピー

■もう一回、結果をコピー後
「抽出結果1」のシートの後ろに「抽出結果2」が作成され、抽出結果がコピーされています。
既存シート名に+1し追加


Homeへ > Excelでアプリケーションソフト2 > 顧客管理ソフトを作ってみよう

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved