Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

81 / 76807

←次へ　｜　前へ→


	【82397】Re:1フォルダ複数ブックExcelを指定した行切り取り1つのデータにしたい

いい

- 24/10/18(金) 16:52 -


	引用なし

	パスワード

▼マナさん：

希望通りの動作できる事確認出来ました
非常に助かります！
ありがとうございました！

>▼いいさん：
>
>
>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

2 hits

▼

【82392】1フォルダ複数ブックExcelを指定した行切り取り1つのデータにしたい いい 24/10/17(木) 18:40