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

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

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