FC2ブログ

資格証.xlsm H29.9.5 最新Ver公開

2017–09–05 (Tue) 21:59
並び替え後、CSVで保存するマクロを作成しました。
使いやすく既に愛用しています。


資格証.xlsm

Sub CSVで保存する()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim aWb As Workbook
Set aWb = Workbooks("資格証.xlsm")
Dim Ws As Worksheet
Set Ws = aWb.Worksheets("資格証全て")
Dim MaxCol As Long
Ws.Sort.SortFields.Clear
With Ws.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With

With Ws.Sort
.SortFields.Add(Range(Ws.Range("B2"), Cells(MaxRow, 2)), _
xlSortOnFontColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0 _
, 102)
.SortFields.Add Key:=Range(Ws.Range("a2"), Cells(MaxRow, 1)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SortFields.Add Key:=Range(Ws.Range("B2"), Cells(MaxRow, 2)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range(Ws.Range("C2"), Cells(MaxRow, 3)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="免,資,溶,特", _
DataOption:=xlSortNormal
.SetRange Range(Ws.Range("a1"), Cells(MaxRow, 12))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With



aWb.Save
Dim book1 As Workbook
Set book1 = aWb
book1.SaveAs Filename:=ActiveWorkbook.Path & "\資格証.csv", _
FileFormat:=xlCSV

Workbooks("資格証.csv").Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
スポンサーサイト



« SUMと足し算 | HOME |  作業時間計算エクセル »

コメント

コメントの投稿

 
管理者にだけ表示

 | HOME | 

プロフィール

はる

Author:はる
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク