| |
▼いい さん：
Sub test()
Dim fdg As FileDialog, p As String
Dim wsCons As Worksheet, c As Range
Dim fn As String, ws As Worksheet, r As Range
Dim n As Long, fx As String
Const d As Long = 10
Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
If Not fdg.Show Then Exit Sub
Set wsCons = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
Set c = wsCons.Cells(1)
p = fdg.SelectedItems(1) & "\"
fn = Dir(p & "リスト*.xlsx")
Do While fn <> ""
Set ws = Workbooks.Open(p & fn).Worksheets(1)
ws.Columns(1).Insert
Set r = ws.Cells(1).CurrentRegion
n = r.Rows.Count
fx = "roundup(row(1:" & n & ")/" & d & ",0)+" & Val(Mid(fn, 4)) / 1000
r.Columns(1).Value = Evaluate(fx)
c.Resize(n, r.Columns.Count).Value = r.Value
Set c = c.Offset(n)
ws.Parent.Close False
fn = Dir()
Loop
Set r = wsCons.Cells(1).CurrentRegion
r.Sort r.Columns(1)
r.Columns(1).Delete xlToLeft
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 24/10/17(木) 18:40 -
