イッシーのカキナグリぶるうす

行数付きのファイルを作成

イッシー — 2009-12-07T01:21:41+09:00

コピーした行数付きのファイルのファイル名の頭には日付と時間が入ります。

Sub ファイル行()
Dim FileType, Prompt, Item As String
Dim FileNamePath, TempFileNamePath, FileName As Variant
Dim textline As String
Dim i, cn, pos As Integer
Dim ch1, ch2 As Long
'
FileType = "すべてのﾌｧｲﾙ (*.*),*.*"
Prompt = "File を選択してください"
FileNamePath = Application.GetOpenFilename(FileType, , Prompt)
'操作したいファイルのパスを取得します
If FileNamePath = False Then 'キャンセルボタンが押された
      End
End If
' pos:パスの文字数
pos = InStrRev(FileNamePath, "\")
' PathName：ファイル名を取り除いた直前のフォルダ名までのパス
PathName = Left(FileNamePath, pos)
' FileName: 拡張子まで含んだファイル名　\以下の文字列を持ってくる
FileName = Mid(FileNamePath, pos + 1)
MsgBox PathName & vbCrLf & FileName
' 空いているファイル番号を取得します
ch1 = FreeFile
' FileNamePath のファイルをオープンします
Open FileNamePath For Input As #ch1

'もうひとつ空いているファイル番号を取得します
ch2 = FreeFile
cn = 0
'テンポラリーファイルにユニークな名前をつけます
'pos = InStrRev(FileNamePath, "\")
'TempFileNamePath = FileNamePath & Format(Now, "yyyymmddhhmmss")
TempFileNamePath = PathName & Format(Now, "yyyymmddhhmmss") & FileName
MsgBox "TempFileNamePath =" & TempFileNamePath
'テンポラリーファイルを作成します
Open TempFileNamePath For Output As #ch2
'
Do While Not EOF(ch1)          'ファイルの終端かどうかを確認します
      cn = cn + 1
      Line Input #ch1, textline 'データ行を読み込みます
      ss1 = "00000" & cn
      ss2 = Right(ss1, 5)
      ss = ss2 & ":" & textline
'    Print #ch2, textline    'データの書き込みをします
      Print #ch2, ss    'データの書き込みをします
Loop

'ファイルを閉じます
Close #ch1, #ch2
'元のファイルを削除します (保留）
' Kill FileNamePath
'テンポラリーファイルを元のファイルの名前に変更します (保留）
' Name TempFileNamePath As FileNamePath
End Sub
Function SelectFileNamePath(FileType, Prompt) As Variant
SelectFileNamePath = Application.GetOpenFilename(FileType, , Prompt)
End Function

選択ファイルのパスとファイル名に分けてＧＥＴ

イッシー — 2009-11-29T19:08:58+09:00

Sub chofile()
Dim PathName As String, FileName As String, pos As Long
Dim FileType, Prompt As String
Dim FileNamePath As Variant
'現在当ファイルを開いている場所をデフォルトに
Call chgpt
FileType = "すべてのﾌｧｲﾙ (*.*),*.*"
Prompt = "File を選択してください"
'操作したいファイルのパスを取得します
FileNamePath = Application.GetOpenFilename(FileType, , Prompt)
If FileNamePath = False Then 'キャンセルボタンが押された
End
End If
pos = InStrRev(FileNamePath, "\")
PathName = Left(FileNamePath, pos)
FileName = Mid(FileNamePath, pos + 1)
MsgBox PathName & vbCrLf & FileName
End Sub
Sub chgpt()
Dim WorkPath As String
WorkPath = ActiveWorkbook.Path
ChDir (WorkPath)
ChDrive (WorkPath)
End Sub

EXCELのシートのデーターをテキストファイルに

イッシー — 2009-11-21T23:53:30+09:00

Sub 文章形式で書き出し()
Set myrng = Range("B3").CurrentRegion
' 書き出したいデーター範囲を取得
ChDir "C:\Documents and Settings\ishi1\デスクトップ\新しいフォルダ"
Open "社員テーブル.txt" For Output As #1
For i = 1 To myrng.Rows.Count
      Print #1, myrng.Cells(i, 1);
      Print #1, myrng.Cells(i, 2);
      Print #1, myrng.Cells(i, 3);
      Print #1, myrng.Cells(i, 4);
      Print #1, myrng.Cells(i, 5)
      ' Print #ステートメントで書き出し　最後に;をつけると改行しない
Next
Close #1
End Sub

固定長をＥＸＣＥＬのセルに読み込んで展開

イッシー — 2009-11-12T00:50:49+09:00

Sub テキスト直読み1行()
'    シートのクリア
Cells.Select
Selection.Clear
Range("A1").Select
'
myRow = 3
ChDir "C:\Documents and Settings\ishi1\デスクトップ\新しいフォルダ"
Open "n社員固定長.txt" For Input As #1
Do Until EOF(1)
   Line Input #1, myRec
   ' Line Input ステートメンテでデーターを１行ごとに読み込む
   Cells(myRow, 2) = myRec
   myRow = myRow + 1
Loop
Close #1

End Sub
Sub data展開()
Dim myRng As Range
Set myRng = Range("B3").CurrentRegion
' データーのセルを展開
myRng.TextToColumns _
   DataType:=xlFixedWidth, _
   fieldinfo:=Array(Array(0, 2), Array(6, 2), Array(20, 9), _
      Array(35, 1), Array(39, 2))
' バイト単位でフールドを指定して展開
End Sub

直接テキストファイルを開く

イッシー — 2009-11-07T01:44:28+09:00

Sub 直接読み()
Dim myRow As Integer, myId, myName, myFur, myAge, myTeam
myRow = 3
' データを書き出す行番号を指定
ChDir "C:\Documents and Settings\ishi1\デスクトップ\新しいフォルダ"
Open "社員.txt" For Input As #1
Do Until EOF(1)
   Input #1, myId, myName, myFur, myAge, myTeam
   Cells(myRow, 2) = myId
   Cells(myRow, 3) = myName
   Cells(myRow, 4) = myFur
   Cells(myRow, 5) = myAge
   Cells(myRow, 6) = myTeam
   myRow = myRow + 1
Loop
Close #1
End Sub