- ベストアンサー
エクセル VBA:複数のシートを1つに集約する方法
- エクセル VBAを使用して複数のシートを1つに集約する方法について質問があります。
- 以前使用していたVBAコードを改良したいと思っていますが、コピーをする際のプロパティ UsedRange について理解できていません。
- また、データが不完全な場合があるため、UsedRangeを使っても思った通りにコピーされないことがあります。
- みんなの回答 (5)
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (4)
- imogasi
- ベストアンサー率27% (4737/17068)
- kagakusuki
- ベストアンサー率51% (2610/5101)
- f272
- ベストアンサー率46% (8052/17216)
- chie65535
- ベストアンサー率43% (8539/19415)
関連するQ&A
- 選択したシートを1つに集約するやり方を教えて下さい
マクロを勉強し始めたばかりの初心者です。 仕事で名簿を管理していますが、複数あるシートのうち2つを1つのシートへ集約したいと考えています。((1)~(8)のシートのうち、(1)電子申請と(2)TEL申込を(3)の申込者名簿シートへ集約したい。) ※(1)~(3)のシート情報は共通の項目となっています。 ※A1が項目、A2から情報が入力されてます。 ※情報は毎日更新・増減されます。 下記のマクロを作成しましたが、(1)電子申請のみ集約され(2)のシートは集約されませんでした。早急に完成し使用したい為、助けを借りたくこちらへ質問させて頂きました。 本当に初心者です。どこを修正したら完成するか教えて頂けたら嬉しいです。 足りない情報がありましたらご質問ください。 Private Sub CommandButton2_Click() Dim sWS As Workssheet '"TEL申込","電子申請" Dim dWS As Worksheet '申込者名簿 Set dWS = Worksheets ("申込者名簿") '申込者名簿の2行目以降を削除 dWS.UsedRange.Offset(1,0).Clear '"TEL申込","電子申請"の2行目以降のデータを、申込者名簿の末尾にコピー For Each sWS In Worksheets If sWS.Name = "電子申請” Or dWS.name = "TEL申込"Then With sWS.UsedRange '申込者名簿にデータが1件以上ある場合 If .Rows.Count > 1 Then .Offset(1,0)/Resize(.Rows.Count - 1).Copy _ Destination:=dWS.Cells(Rows.Count, 1)._ End(xlUp).Offset(1,0) End If End With End If Next sWS End Sub
- ベストアンサー
- Excel(エクセル)
- エクセルVBA の変数を使うべきでしょうか?
はじめまして。エクセル初心者です。 書籍やサイトで勉強させてもらっていますが、VBAがなかなか難しくてすぐに壁にぶつかってしまいます。少々困ってしまい、詳しい方のアドバイスを頂ければと質問を投稿させていただきました。 どうか宜しくお願い致します。質問ですが、 以下のようなコードで、sheet5のB列の任意のセルをダブルクリックした場合、sheet5のBCD列の同じ行のセル値がsheet1の指定した列に入力されるという処理を作りました。 これで一応目的の動作はするのですが、数が増えると「コンパイルエラー・プロシージャが大きすぎます」というメッセージがでてしまいます。列や行には規則性があるので、もしかしたら変数というものを使ってコードを書き直せばいいのかなと思いネットで調べてみたのですが、今のところさっぱり理解できません。 申し訳ありませんが、分かりやすくご教授いただけないでしょうか。バージョンは2003を使っています。 また、下のコードですと、sheet5のBCDいずれかのセルに空白があった場合、sheet1の列に入力されるときに入力される行がずれてしまいます。今は空白を何かで埋めて対処しているのですが、この問題の解決策も教えて頂けると助かります。どうか宜しくお願い致します。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Target.Address = "$B$2" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B2") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C2") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D2") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$3" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B3") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C3") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D3") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$4" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B4") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C4") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D4") Worksheets("sheet1").Activate cancel = True End If ・ ・ ・ ・ ・ ・ End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル 複数シートを一つのシートにまとめるマクロについて
エクセル 複数シートを一つのシートにまとめるマクロについて こんにちは いつもお世話になっています あるサイトから上記の目的のマクロを参考にして試したんですが、所有してるデスクトップPCでは成功するのに、ノートPCでは次のエラーが出ます。 「コンパイルエラー 変数が定義されていません」そして、以下に載せたコードの「k = 1」の部分が青い背景色になります。とりあえず、デスクトップでできるので間に合うのですが、ノートPCでのトラブル理由を今後のために勉強したいのです。理由を教えてください。 エクセル2003 SP3 ノートPCは工人舎のモバイルSA1F0 参考にさせていただいたサイトは「エクセル 複数シートを一つに集約」 http://okwave.jp/qa/q1608016.html?order=DESC&by=datetime コード引用 集約用にSheet3を確保します・ Sheet3以外の全シートを集約します。 Sub test07() Dim sh3 As Worksheet Dim sh As Worksheet Set sh3 = Worksheets("Sheet3") k = 1 For Each sh In ActiveWorkbook.Worksheets If sh.Name <> "Sheet3" Then MsgBox sh.Name sh.UsedRange.Copy sh3.Cells(k, "A").Select sh3.Paste k = k + sh.UsedRange.Rows.Count End If Next End Sub 引用終わり よろしくお願いします
- ベストアンサー
- その他MS Office製品
- VBA 任意のシートからコピーを始める。
教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i
- ベストアンサー
- Visual Basic
- 複数のエクセルシートをまとめるマクロ
下は複数のエクセルファイルを一つにするマクロですが、100万件を超えるためcsvで保存するようにするにはどこを変更したらよいでしょうか。 よろしくお願いします。 Sub Sample() Dim t As Single Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long 'A列に値が入っているデータ数 t = Timer 'まとめたいシート Set WS2 = ThisWorkbook.Worksheets(1) strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Worksheets(1) With WS1.Range("A1") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 14).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With WB1.Close False End If strFileName = Dir Loop MsgBox "まとめ処理をしました。処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss") End Sub
- ベストアンサー
- Excel(エクセル)
- Excel VBAについて
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub Application.Goto Worksheets("人件費").Range("A1") Worksheets("人件費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub Application.Goto Worksheets("外注費").Range("A1") Worksheets("外注費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub 上の指令はFの列をダブルクリックすると人件費のシートが開いてAある値を人件費の新しいセルのAに代入する指令ですが それをG列ダブルクリックで外注費シートに同じようにやろうと思いましたが出来ません。 たぶん根本的に書き方が間違っているのかと思われますが、ご指導のほどお願いします。
- ベストアンサー
- Excel(エクセル)
- 複数のファイルのsheet1だけをまとめるには
sub UsedRangeをOffsetする() Dim rng先 As Range Dim PathMacrobook As String Dim Name元book As String Dim 元Book As Workbook Dim 元Sheet As Worksheet Set rng先 = Workbooks("BOOKALL.xls").Worksheets(1).Range("A2") PathMacrobook = ThisWorkbook.Path & "\" Name元book = Dir(PathMacrobook & "*.xls") Do While Not Name元book = "" If Name元book = ThisWorkbook.Name Then ElseIf Name元book = "BOOKALL.xls" Then Else Set 元Book = Workbooks.Open(PathMacrobook & Name元book) For Each 元Sheet In 元Book.Worksheets With 元Sheet.UsedRange .Offset(1).Copy rng先 Set rng先 = rng先.Offset(.Rows.Count - 1, 0) End With Next 元Book.Close False End If Name元book = Dir() Loop End Sub このコードではフォルダにあるブックのすべてのシートをBOOKALLのシート1に 上書きコピーしてしまう事がわかりました。 やりたい事 オープンするブックのsheet1だけを、.end(xlup)を使って一覧にしたいです。。 どの様にしたらよいでしょうか?
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAについての質問です。
ExcelのVBAについての質問です。 計測機器をつないでsheet1に数値が書き込まれていってる状況です。下記のプログラムを特定の時間内に複数回ループされるように設定したいのですが、そのようなプログラムを加えればいいのでしょうか? Sub Macro1() ' ' Macro1 Macro ' ' Dim iRows As Integer Dim sRows As String ' 最終行の調査: iRows = Worksheets("Sheet1").UsedRange.Rows.Count ' 最終行をシート3にコピー Worksheets("Sheet1").Rows(iRows).Copy Destination:=Worksheets("Sheet3").Range("1:1") ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B4").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("B5").Value = Worksheets("Sheet1").Cells(iRows, 4).Value End Sub
- ベストアンサー
- Visual Basic
- 決まったシートだけコピーして一つのシートにまとめる
お世話になります。 http://okwave.jp/qa/q8216220.html で質問させていただいたVBAをこねくり回してみたのですが、「インデックスが有効範囲にありません」というエラーがでて進まなくなってしまいました。 Sub 特定のシートだけコピーと貼り付け() Dim k As Long, endRow As Long, wS As Worksheet Dim P As Variant P = Array("全", , "A", "B", "C", "D", "E", "F", "G", "H", "I") '↑コピーしたいシート名一覧 Set wS = Worksheets("まとめ") endRow = wS.cells(Rows.Count, "B").End(xlUp).Row If endRow > 4 Then Range(wS.cells(5, "B"), wS.cells(endRow, "M")).ClearContents End If For k = LBound(P) To UBound(P) ☆If Worksheets(k).Name <> "まとめ" Then 'ワークシート名が"まとめ"のとき endRow = Worksheets(P).cells(Rows.Count, "B").End(xlUp).Row 'P=Arrayで指定しているシートのセルで If endRow > 4 Then '4行目より下を Range(Worksheets(P).cells(5, "B"), Worksheets(P).cells(endRow, "M")).Copy _ wS.cells(Rows.Count, "B").End(xlUp).Offset(1) 'B5からM列の任意のデータが入っているセルまでコピーして"まとめ"シートに貼り付け End If '繰り返す End If '繰り返す Next k '次のシートへ End Sub 自分で分かるようにコメントを付けています。 ☆のついているところで、「インデックスが有効範囲にありません」と出ます。 指定したシートに"まとめ"を追加してみてもやはり同じでした。 調べたところ、「インデックスが~」というのはVBA中の範囲にないものを指定しているからだ、ということなのですが・・・。 お知恵を貸して下さい。よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- VBA フォルダ内のファイルを昇順に読み出す方法
以下のような簡単なプログラムを組みました。 ファイル名を昇順に読み出せると思っていましたが、そうならない場合があるようです。 なぜなのでしょうか? また、どうすればファイルを昇順に読み出せるのでしょうか? どなたか教えて頂けないでしょうか? (抜粋) Set WS1 = Worksheets("データー(org)") '書き出すシート Set WS3 = Worksheets("集計") Dim a As String With Application.FileDialog(msoFileDialogFolderPicker) .Show PathName = .SelectedItems(1) & "\" 'ファイルの入っているフォルダを指定 End With BookName = Dir(PathName) '処理するファイル Do Until BookName = "" Workbooks.Open PathName & BookName 'ファイルを開く Set WS2 = Worksheets(1) '読み込むシート WS2.Rows("1:" & WS2.UsedRange.Rows.Count).Copy If WS1.UsedRange.Rows.Count = 1 Then WS1.Rows(WS1.UsedRange.Rows.Count).PasteSpecial Paste:=xlValues Else WS1.Rows(WS1.UsedRange.Rows.Count + 1).PasteSpecial Paste:=xlValues End If Workbooks(BookName).Close 'ファイルを閉じる BookName = Dir() 'ファイル名をクリア Loop
- 締切済み
- Visual Basic
お礼
コメントありがとうございます。 まずVBAの中身を知りたかったというのもあり、質問させていただきましたが、ご指摘のとおりこのVBAが機能するようにデータ管理をしていきたいと思います。