|
固定長レコードを意識しないならこんなでも
Option Explicit
Public Sub Sample_2()
Dim i As Long
Dim lngRows As Long
Dim rngList As Range
Dim vntData As Variant
Dim vntFilename As Variant
Dim dfn As Integer
Dim strFilter As String
Dim strBuff As String
Dim strProm As String
'フィルタ文字列を作成
strFilter = "Text File (*.txt),*.txt"
'出力ファイル名を取得
vntFilename = Application.GetSaveAsFilename(, strFilter)
If VarType(vntFilename) = vbBoolean Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
End If
'◆Listの先頭セル位置を基準とする(先頭列の列見出しのセル位置)
Set rngList = ActiveSheet.Range("A1")
With rngList
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'列データを配列に取得
vntData = .Offset(1).Resize(lngRows + 1).Value
End With
'出力ファイルをOpen
dfn = FreeFile
Open vntFilename For Output As dfn
'Key列に就いて繰り返し
For i = 1 To lngRows
strBuff = Right(String(4, "0") & vntData(i, 1), 4)
Print #dfn, "項番" & i & " " & strBuff
Next i
Close #dfn
strProm = "処理が完了しました"
Wayout:
Set rngList = Nothing
MsgBox strProm, vbInformation
End Sub
|
|