エクセル顧客管理
その後№1、CSV出力を追加

Excelマクロを駆使したカスタマイズ可能なエクセル顧客管理、エクセルVBAの学習教材
公開日:2013年5月以前 最終更新日:2014-11-11

その後№1、CSV出力を追加


エクセルで顧客管理を作ろう、


一旦終了しましたが、その後に機能追加していることについて、有益な部分をここで紹介します、


説明は簡潔にしています、おそらくこれを読む人は、それなりにVBAをしっている方だとの判断です。


今回はCSVの出力です。


2通りの方法を紹介します。



まずは、エクセルの機能をそのまま利用します。


Sub CSV出力(ByVal sht As Worksheet, Optional ByVal rngStart As Range = Nothing)
  Dim varFile As Variant
  
  varFile = Application.GetSaveAsFilename(InitialFileName:=sht.Name & ".csv", _
                      FileFilter:="CSVファイル(*.csv),*.csv", _
                      FilterIndex:=1, _
                      Title:="保存ファイルの指定")
  If varFile = False Then
    Exit Sub
  End If
    
  sht.Select
  sht.Copy
  

  '不要な先頭の行列を削除します。
  If Not rngStart Is Nothing Then
    If rngStart.Row > 1 Then
      Range(Rows(1), Rows(rngStart.Row - 1)).Delete
    End If
    If rngStart.Column > 1 Then
      Range(Columns(1), Columns(rngStart.Column - 1)).Delete
    End If
  End If
  
  ActiveWorkbook.SaveAs Filename:=varFile, FileFormat:=xlCSV, CreateBackup:=False
  ActiveWindow.Close
  
  MsgBox ("CSV出力しました。" & vbLf & vbLf & varFile)
End Sub


引数で、ワークシートと開始セルを指定できるようにしています。

これにより、どのシートからも使えるようになります。


Application.GetSaveAsFilename

保存ファイルを選択するダイアログを表示します。

シート名+「.csv」を初期のファイル名にしています。

拡張子は、csvのみ指定しています。


開始セルより上の行、左の列は削除して、CSVに出力されないようにしています。


処理の流れは、


保存ファイルの選択

シートの新規ブックへのコピー

不要な行列の削除

名前を付けて保存


これは簡単です。


しかし、これでは、いろいろ不都合な場合があります。


他システム、特にDB等へアップロードする場合には、このままでは出来ない事があるのです。


例えば、日付は、表示形式のままの文字列で出力されてしまいます。


また数値もカンマ付の場合は、"12,345"のように、文字列として出力されます。


CSV出力前に、当該シートの書式を全て直してから行えばよいのですが、


書式の変更も面倒なら、また元に戻す必要があり、何かと不都合です。



このような場合は、直接CSVを出力するようにします。




Sub CSV出力(ByVal sht As Worksheet, Optional ByVal rngStart As Range = Nothing)
  Dim varFile As Variant
  Dim FSO As New FileSystemObject
  Dim TS As TextStream
  Dim lngRowMin As Long, lngRowMax As Long
  Dim lngColMin As Long, lngColMax As Long
  Dim i As Long

  
  varFile = Application.GetSaveAsFilename(InitialFileName:=sht.Name & ".csv", _
                      FileFilter:="CSVファイル(*.csv),*.csv", _
                      FilterIndex:=1, _
                      Title:="保存ファイルの指定")
  If varFile = False Then
    Exit Sub
  End If
    
  '開始行列、終了行列を取得
  If rngStart Is Nothing Then
    lngRowMin = 1
    lngColMin = 1
  Else
    lngRowMin = rngStart.Row
    lngColMin = rngStart.Column
  End If
  lngRowMax = 最終行取得(sht)
  lngColMax = 最終列取得(sht)
  
  Set TS = FSO.CreateTextFile(Filename:=varFile, Overwrite:=True)
  
  For i = lngRowMin To lngRowMax
    TS.WriteLine CSV_EditRec(sht, i, lngColMin, lngColMax)
  Next
  
  TS.Close
  Set TS = Nothing
  Set FSO = Nothing

  MsgBox ("CSV出力しました。" & vbLf & vbLf & varFile)
End Sub



Private Function CSV_EditRec(ByVal sht As Worksheet, _
                i As Long, _
                lngColMin As Long, _
                lngColMax As Long) As String
  Dim strRec As String
  Dim strCol As String
  Dim j As Long

  strRec = ""
  For j = lngColMin To lngColMax
    Select Case True
      Case IsNumeric(sht.Cells(i, j))
        strCol = CStr(CDbl(sht.Cells(i, j)))
      Case IsDate(sht.Cells(i, j))
        If InStr(sht.Cells(i, j), "-") Then
          strCol = sht.Cells(i, j)
        Else
          strCol = Format(sht.Cells(i, j), "yyyy/mm/dd")
        End If
      Case InStr(sht.Cells(i, j), ","), InStr(sht.Cells(i, j), """")
        strCol = """" & sht.Cells(i, j) & """"
      Case Else
        strCol = sht.Cells(i, j)
    End Select
    If strRec = "" Then
      strRec = strCol
    Else
      strRec = strRec & "," & strCol
    End If
  Next
  CSV_EditRec = strRec
End Function

Function 最終行取得(ByVal sht As Worksheet) As Long
  Dim ary As Variant
  Dim i As Long, j As Long
  ary = sht.Range(sht.Cells(1, 1), sht.Cells.SpecialCells(xlLastCell))
  Do
    For i = UBound(ary, 1) To LBound(ary, 1) Step -1
      j = 1
      For j = LBound(ary, 2) To UBound(ary, 2)
        If ary(i, j) <> "" Then
          最終行取得 = i
          Exit Function
        End If
      Next j
    Next i
  Loop
End Function

Function 最終列取得(ByVal sht As Worksheet) As Long
  Dim ary As Variant
  Dim i As Long, j As Long
  ary = sht.Range(sht.Cells(1, 1), sht.Cells.SpecialCells(xlLastCell))
  Do
    For i = UBound(ary, 2) To LBound(ary, 2) Step -1
      j = 1
      For j = LBound(ary, 1) To UBound(ary, 1)
        If ary(j, i) <> "" Then
          最終列取得 = i
          Exit Function
        End If
      Next j
    Next i
  Loop
End Function


かなり長いですが、


「最終行取得」、「最終列取得」は以前に作成済のモジュールです。


行列がでこぼこに入力されている場合でも、正しく最終判定をする為に使用しています。


通常の一覧なら、End(xlUp)等でも良いでしょう。


FileSystemObjectを使用していますが、昔からある、


Open ファイル For Output As #1


でも良いです。


処理内容は単純です。


要は、


Function CSV_EditRec

の内容だけでしょう。


セルの値を判定し、データ内容によって、編集処理を分けています。


ここでは、数値、日付、「"」や「,」を含む文字列、その他、の4通りです。


日付の場合は、「-」の入った電話番号が日付判定される場合があるので、除外しています。


「CSV_EditRec」での編集は、CSVの使い道により、変更を加える必要があります。


例えば、日付は、「#2011/05/17#」のようにする必要がある場合もでてくるでしょう。


いずれにせよ、上記モジュールはかなり汎用的に作成してありますので、


コピペで、いろいろ使い回しが可能です。



今回は、CSVの出力を作成したところ、共有出来そうなプログラムだったので、紹介をしました。


今後も、追加情報があれば、プログで紹介していきます。





同じテーマ「エクセル顧客管理」の記事

第28回.納品書データをデータベース化(1)
第29回.納品書データをデータベース化(2)
第30回.配列の使い方について
第31回.売上一覧(伝票合計の一覧)を作成(1)
第32回.売上一覧(伝票合計の一覧)を作成(2)
第33回.売上一覧より納品書を作成
第34回.伝票番号の自動採番機能を追加
第35回.メニューを作成
第36回.最終回
その後№1、CSV出力を追加
その後№2、ベクター掲載


新着記事NEW ・・・新着記事一覧を見る

ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ