| |
基本的にはこんな物で出来ると思いますが？
ファイル名の重複、ファイル名の不正文字等の処理をしていませんので
これを行って下さい
また、データには列見出しが有る物とします
Option Explicit
Public Sub Sample()
'◆データ列数（A列〜B列）
Const clngColumns As Long = 2
Dim i As Long
Dim lngRows As Long
Dim rngList As Range
Dim vntData As Variant
Dim dfn As Integer
Dim strPath As String
Dim strProm As String
'◆Listの先頭セル位置を基準とする（A列の列見出しのセル位置）
Set rngList = ActiveSheet.Cells(1, "A")
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, 2).Value
End With
'画面更新を停止
' Application.ScreenUpdating = False
'◆出力先フォルダを指定
strPath = ThisWorkbook.Path & "\"
For i = 1 To lngRows
dfn = FreeFile
Open strPath & vntData(i, 1) & ".txt" For Output As dfn
Print #dfn, vntData(i, 2)
Close #dfn
Next i
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
MsgBox strProm, vbInformation
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
