| |
▼Jaka さん、Keinさん：
ありがとうございます。どうにか希望どおりにできました。下記最終結果をご参照ください。
>要するに保存したい場所、ファイル名は自分で文字を組み合わせて、
保存時のパスは自分で組み合わせるのですね。
でもひとつ教えてください。
Keinさんの ActiveWorkbook.Close True, "C:新しいフォルダ\" & Dv & ".xls"と
Jakaさんの ActiveWorkbook.SaveAs FileName:= "C:\・・・・は同じことなんでしょうか？
＜最終結果＞
Option Base 1
Sub ReadtTxt()
Dim myTxtFile As String
Dim myBuf(21) As String
Dim i As Integer
Dim j As Integer
Dim k As String
Dim Dv As String
Application.ScreenUpdating = False
myTxtFile = ActiveWorkbook.Path & "\mail.csv"
Worksheets("test").Activate
Open myTxtFile For Input As #1
Do Until EOF(1)
Input #1, myBuf(1), myBuf(2), myBuf(3), myBuf(4), myBuf(5), myBuf(6), myBuf(7), myBuf(8), myBuf(9), myBuf(10), myBuf(11), myBuf(12), myBuf(13), myBuf(14), myBuf(15), myBuf(16), myBuf(17), myBuf(18), myBuf(19), myBuf(20), myBuf(21)
i = i + 1
For j = 1 To 21
Cells(i, j) = myBuf(j)
Next j
Loop
Close #1
Columns("B:R").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").Select
Selection.NumberFormatLocal = "0_);[赤](0)"
Selection.ColumnWidth = 15
Columns("B:B").Select
Selection.ColumnWidth = 105
Range("B1").Select
ActiveCell.FormulaR1C1 = "書名"
Columns("D:D").Select
Selection.ColumnWidth = 15
With Sheets("test")
Dv = Format(DateValue(.Range("C2").Value), "mmdd")
.Copy
End With
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveSheet.Name = Dv
ActiveWorkbook.Close True, "C:新しいフォルダ\" & Dv & ".xls"
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("A1").Select
ActiveWorkbook.Close True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
