エクセルの学校：全文検索：Hyper Estraier： cell filename

Results of 1 - 1 of about 295 for cell filename (0.001 sec.)

cell (1170), filename (1984)

[[20230713094340]]: #score: 11157; @digest: 161b910729e6386dbce1284f6a496e1a; @id: 94687; @mdate: 2023-07-18T00:56:28Z; @size: 6153; @type: text/plain; #keywords: extractrange (50877), newworkbook (30637), targetsheet (28686), 業フ (27843), pasterange (17590), ト目 (15110), 力列 (11420), 力sh (8790), ルブ (8477), ク名 (7560), 得fi (7112), filepath (5478), 目b (5406), ブッ (3843), ・作 (3765), 応可 (3501), ダ内 (3204), ダパ (2751), filename (2543), 名= (2440), 出力 (2235), 名称 (2223), ォル (2171), ルダ (1859), ック (1799), フォ (1523), xltoleft (1513), 新規 (1499), 規ブ (1344), 名2 (1316), workbooks (1291), autofilter (1136); 『複数ブックの指定列を抽出し、新規ブックの1シートに横に並べて貼りつけ』（ケッタリー）
初めましてよろしくお願いいたします以下の作業はマクロで対応可能と考えておりますが、コードが思いつきません、コード作成に対して、情報が不足しているとは思いますが、ご教示をお願いいたします。・作業フォルダ内に複数のエクセルブックエクセルブック名称は先頭に5桁の通し番号があるが一部に5桁の通し番号が同一で、それに続く文字列が異なるものがある・エクセルブックは2シートで構成・2シート目のシート名称はすべて同じ作業フォルダに格納されている複数のエクセルブックの2シート目のB列を抽出し、新規エクセルブックの1シート目に貼り付け作業フォルダ内に並べられているブック名の順番で新規ブックの1シート目に左からは貼り付けていく。 ※2シート目のB列はフィルタがかかっているフィルタはB列の値が0の場合に表示から外す ※2シート目のA列はA1に項目名称 A2に0 A3に1 A52に50 ※B列は52行生成イメージ 1行目はエクセルブック名称 2行目から抽出したB列を貼りつけ A B C D E 11ブック名 2ブック名1 2ブック名2 3ブック名 22シート目B列のB1 2シート目B列のB1 32シート目B列のB2 42シート目B列のB3 ＜使用 Excel:Microsoft365、使用 OS:Windows11 ＞ ---- ＞コードが思いつきませんでは、日本語でプログラムを作っては如何でしょう。そして、その日本語をVBAのコードにする時に、ネットで調べながらコードを書いていく。これでもわからない時には、掲示板に問い合わせる。自分もとある掲示板で、この様に指導され、今ではVBAを他人に教えるくらいまでになりました。例えば、、、・新規Excelファイルを開く・作業フォルダ内のExcelファイルを1ずつ順番に開く・開いたファイル名をA1セルに記入する・開いたファイルの「○×△」というシート名のB列を新規で開いたファイルのA列に転記するみたいな感じです。（匿名） 2023/07/13(木) 10:15:55 ---- 質問をコピーして、そのままChatGPTに投げてみました。その結果が以下です。ちなみに内容の確認、デバッグ等は全く行っていないので悪しからず。 Sub ExtractAndPaste() Dim filePath As String Dim fileName As String Dim newWorkbook As Workbook Dim targetSheet As Worksheet Dim pasteRange As Range Dim extractRange As Range Dim cell As Range ' 作業フォルダのパスを取得 filePath = ThisWorkbook.Path & "¥" ' 新しいブックを作成 Set newWorkbook = Workbooks.Add ' 新しいブックの1番目のシートを取得 Set targetSheet = newWorkbook.Sheets(1) ' フォルダ内の各ブックについて処理 fileName = Dir(filePath & "*.xlsx") Do While fileName <> "" ' ブックを開く Workbooks.Open (filePath & fileName) ' 2番目のシートのデータ範囲を取得 Set extractRange = Workbooks(fileName).Sheets(2).Range("B1:B52") ' フィルタがかかっている場合、フィルタを解除 If extractRange.AutoFilterMode Then extractRange.AutoFilter End If ' フィルタを設定 extractRange.AutoFilter Field:=1, Criteria1:="<>0" ' 抽出したデータを新しいブックに貼り付け If targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Column = 1 Then ' 1行目にブック名を貼り付け targetSheet.Cells(1, targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Column + 1).Value = fileName ' 2行目から抽出したデータを貼り付け Set pasteRange = targetSheet.Cells(2, targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Column) extractRange.SpecialCells(xlCellTypeVisible).Copy pasteRange End If ' フィルタを解除 extractRange.AutoFilter ' ブックを閉じる Workbooks(fileName).Close SaveChanges:=False ' 次のブック名を取得 fileName = Dir() Loop ' 新しいブックを保存 newWorkbook.SaveAs filePath & "結果.xlsx" ' 新しいブックを閉じる newWorkbook.Close SaveChanges:=False MsgBox "処理が完了しました。" End Sub （ものは試し） 2023/07/13(木) 10:20:57 ---- ■1 ＞以下の作業はマクロで対応可能と考えておりますが、コードが思いつきません。とはいえ、マクロで対応可能と判断するからには部分的には考えついているわけですよね? とりあえず、何処で詰まっているのか現状のコードを示されてはどうでしょうか? 既に提案があるように【疑似コード】でもよいと思います。 ■2 行・列を踏まえたレイアウトがないので、今一つピンと来ませんが↓は無理かもしれません＞作業フォルダ内に並べられているブック名の順番で新規ブックの1シート目に左からは貼り付けていく別途【作業フォルダ内に並べられているブック名の順番】とやら（またはその並び順ルール）を取得して【並び替え】をすることも考えたほうが良いかもしれません。（もこな2） 2023/07/13(木) 10:28:56 ---- 残念ながらトピ主の反応がありませんが追加で。 ■3 以下の情報から考えて、全部とは言いませんが多くの部分は【マクロの記録】で必要な命令を調べることができるとおもいます。・作業フォルダ内に複数のエクセルブック・複数のエクセルブックの2シート目のB列 ※2シート目のB列はフィルタがかかっている ※B列は52行新規エクセルブックの1シート目に貼り付け生成イメージ 1行目はエクセルブック名称 2行目から抽出したB列を貼りつけ踏まえて、検証していませんが、ざっくりと組み立てると↓のような感じになるのではないでしょうか? Sub 研究用() Const フォルダパス As String = "C:¥作業フォルダ¥" Dim ブック名 As String Dim 出力列 As Long Dim 出力SH As Worksheet Set 出力SH = Workbooks.Add.Worksheets(1) 出力列 = 1 ブック名 = Dir(フォルダパス & "*.xks?") Do Until ブック名 = "" 出力SH.Cells(1, 出力列).Value = ブック名 With Workbook.Open("フォルダパス" & ブック名) .Worksheets(2).Range("B2:B52").Copy 出力SH.Cells(2, 出力列) .Close End With 出力列 = 出力列 + 1 ブック名 = Dir() Loop End Sub "質問"であるなら、現状のコードを示して詰まっているところを具体的に聞いたほうが的確なアドバイスが得られやすくなりますし、作成依頼をしたいということならその旨はっきり書いておいた方が、回答者さんと気持ちのすれ違いがおきなくてよいとおもいます。（もこな2） 2023/07/18(火) 09:56:28 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/202307/20230713094340.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ