|
Option Explicit
Sub データ作成()
' Dim i As Integer
' Dim j As Integer
Dim i As Long
Dim j As Long
Dim buf As String
Dim code As String
'宣言の無い変数
Dim FileNum As Integer
Dim FileName1 As String
Dim WS_k As Range '?
Dim strPath As String
'出力ファイル名を設定
' FileName1 = Workbooks(1).Path
strPath = Workbooks(1).Path & "\"
' FileName1 = FileName1 & "\コード.csv"
FileName1 = "コード.csv"
'データ範囲を変数に取得
Set WS_k = Worksheets("商品シート").UsedRange
'ファイルを出力モードでOpen
FileNum = FreeFile
' Open FileName1 For Output As FileNum
Open strPath & WS_k(1, 1).Value & FileName1 For Output As FileNum
'指定シートの全範囲を変数に取得???
' Set WS_k = Worksheets("商品シート").Cells
' 'バファをクリア
' buf = ""
'読み込み位置の初期値設定
i = 1
'読み込み位置の「種別」を変数codeに代入
' code = WS_k(i, 1)
code = WS_k(i, 1).Value
' Do Until WS_k(i, 1) = ""
Do Until WS_k(i, 1).Value = ""
'「種別」が変わったら
' If code <> WS_k(i, 1) Then
If code <> WS_k(i, 1).Value Then
' '出力ファイルをBookとして開く
' Workbooks.Open Filename:=FileName1
' '開いたBookを別名で保存
' ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path _
' & "\" & StrConv(code, vbWide + vbUpperCase) & "コード.csv"
' '開いたBookを閉じる
' ActiveWorkbook.Close
'出力ファイルをClose
Close FileNum
'ファイルを出力モードでOpen
FileNum = FreeFile
' Open FileName1 For Output As FileNum
Open strPath & WS_k(i, 1).Value & FileName1 For Output As FileNum
'読み込み位置の「種別」を変数codeに代入
' code = WS_k(i, 1)
code = WS_k(i, 1).Value
End If
'データを1レコード分(10フィールド)作成
'バファをクリア
buf = ""
' For j = 1 To 10
' buf = buf & Trim(WS_k(i, j)) & ","
' Next j
For j = 1 To WS_k.Columns.Count
If buf <> "" Then
buf = buf & ","
End If
buf = buf & Trim(WS_k(i, j).Value)
Next j
'データを出力
'何故、バファ番号が#1か?
'FileNumは?
' Print #1, (buf)
Print #FileNum, (buf)
' 'バファをクリア
' buf = ""
'読み込み位置をインクリメント
i = i + 1
Loop
'出力ファイルをClose
Close FileNum
Set WS_k = Nothing
End Sub
|
|