| |
一応、集計でアウトラインレベル[2]表示した可視範囲を
テキストファイル出力するまでの操作をマクロ記録し、
それを加工したコードを(参考までに)Upしておきますね。
Option Explicit
Sub Macro1()
' マクロ記録日 : 2009/5/16 ユーザー名 : kanabun
'
With Range("A1").CurrentRegion
' 集計
.Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=Array(2), _
Replace:=True, SummaryBelowData:=True
End With
With Range("A1").CurrentRegion
' C列「コメント」の合計行へのフィル
.Columns(3).Cells.Resize(.Rows.Count - 1) _
.SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
' アウトラインレベルを[2]にして 合計行だけ表示
.Worksheet.Outline.ShowLevels RowLevels:=2
End With
'出力先フォルダとファイル名の指定
Dim io As Integer
Dim myText
Dim myFilter As String
Dim myTitle As String
myTitle = "名前を付けて範囲の保存"
myFilter = "Textファイル,*.txt,CSVファイル,*.csv"
myText = ActiveSheet.Name & "_合計"
myText = Application.GetSaveAsFilename( _
myText, myFilter, 1, myTitle)
If VarType(myText) = vbBoolean Then Exit Sub
'可視セルだけCopyしてクリップボードへ送る
Range("A1").CurrentRegion. _
SpecialCells(xlVisible).Copy
' クリップボードのデータをテキスト形式でファイル出力
Dim ss As String
Const CLSID_DataObject = _
"1C3B4210-F441-11CE-B9EA-00AA006B1A69"
With GetObject("new:" & CLSID_DataObject)
.GetFromClipboard
ss = .GetText 'Clipboard内の(Tab区切り)Textを取得
End With
Application.CutCopyMode = True
io = FreeFile()
Open myText For Output As io
If myText Like "*.csv" Then '拡張子がcsvのときは
ss = Replace(ss, vbTab, ",") 'Tabを<,>に置換
End If
Print #io, ss; 'ファイル出力
Close io
MsgBox "保存しました", , myText
End Sub
※クリップボード経由で出力しなくても、 シートが一枚だけの新規Bookに
直前の方法で可視セルだけコピーして、それをファイルメニュ−から
[名前をつけて保存](ファイルの種類を *.txtとか *.csvを指定して)
保存してもいいです。
|
|
kanabun
- 09/5/16(土) 21:48 -
