• 締切済み

ブック.csvを開かずに他のブック.xlsに貼付け

nag0720の回答

  • nag0720
  • ベストアンサー率58% (1093/1860)
回答No.3

>テキストファイルとして読み込んで >処理時間は早くなるでしょうか? 通常は、エクセルのシートを使わずにVBAの変数だけで処理し、シートへの書き込みも配列でまとめてドカッと書き込めば早くなります。 ただ、問題となるのはソートのアルゴリズムです。 ヘタなアルゴリズムにすればブックを開いて処理するより時間が掛かるかもしれません。 シート上でのソートは最適なアルゴリズムを使っているはずなので、VBAによるソートはそれよりも早くすることはできないと思いますが、近づけることはできます。 データ件数はどのくらいか? 1件の項目数は? どの項目でソートする? ソート項目の型は? ソート項目に何か特性はあるのか? など、これらの違いによって、どんなアルゴリズムにすれば効率よくソートできるかが変わってきます。

kyy0108
質問者

補足

すみません、アドバイスください データ件数:2万~3万件 1件の項目数:8項目 どの項目でソート:3項目について優先順位をつけソート (名称(1)(2)(3)) ソート項目の型:名称で昇順 ソート項目に何か特性:すべてのファイルに共通して            同じ項目が1行目にある            しかし2行目から50行目までが            ファイルで順序が違う(必ず50行まである)            よって、いつも同じ順序でコピー・貼り付けをしたいため            ソートしている これで意味がわかりますかね? 1つのファイルのイメージ 名称(1) 名称(2) 名称(3)  判定 計測結果 上限   下限  判定 AAA  BBB  CCC   1  10  15 10  OK DDD  SSS  ZZZ   1  13  12  10  OK BBB  CCC  DDD   2   9  12  10  NG 50行まである 以上、処理速度が速くなりそうであれば VBAのコードを教えていただきたく よろしくお願いいたします。

関連するQ&A

  • マクロで複数ブックのデータを一つのブックにコピー

    マクロ超初心者です。 1つのフォルダの中に複数のbook(sheetも複数)があります。 これを新しい1つのbookにまとめたいです。 sheetは「bookを開いた時に表示されるsheetだけ」を新しいbookにまとめたいです。 どなたかの回答に下記マクロがありました。 Sub consolid() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Worksheets.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く wb.Close '開いたブックを閉じる n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox n & "件のブックをコピーしましました。" End Sub このマクロを使わせていただき、 これでいける!と思ったのですが、255文字以上のコピーが出来ません。 どのようにすればよいでしょうか?

  • Excel マクロで複数ブックのデータを一つのブックにまとめる方法

    マクロ初心者です。 1つのフォルダの中に複数のbook(sheetも複数)があります。 これを新しい1つのbookにまとめたいです。 回答に下記マクロがありました。 Sub consolid() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Worksheets.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く wb.Close '開いたブックを閉じる n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox n & "件のブックをコピーしましました。" End Sub これで使用した所マクロを実行する度に何度も同じシートが コピーされてしまいます。 できれば同じ名前のシートは上書きにしてマクロを何度も使用できるように【各BOOKは毎週更新されて私のフォルダに入ってきます】したいのですが そのような事は可能なのでしょうか? どなたか分かる方教えてください。お願い致します。

  • Excel マクロで複数ブックのデータを一つのブックにまとめる方法

    マクロ初心者です。 1つのフォルダの中に複数のbook(sheetも複数)があります。 これを新しい1つのbookにまとめたいです。 sheetは「bookを開いた時に表示されるsheetだけ」を新しいbookにまとめたいです。 どなたかの回答に下記マクロがありました。 Sub consolid() Application.ScreenUpdating = False '画面更新を一時停止 Set mb = ThisWorkbook 'このコピー先ブックをmbとする。 myfdr = ThisWorkbook.Path fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索 Do Until fname = Empty '全て検索 If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。 wb.Worksheets.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く wb.Close '開いたブックを閉じる n = n + 1 'ブック数をカウント End If fname = Dir 'フォルダ内の次のExcelブックを検索 Loop '繰り返す Application.ScreenUpdating = True '画面更新一時停止を解除 MsgBox n & "件のブックをコピーしましました。" End Sub 非常によかったのですが、これですと (1)全てのsheetがコピーされてしまいます。 (2)また、保存しますか?とbookごとに聞いてきます。 上記のマクロのどこを変更すれば、(1)(2)を解決できますでしょうか? (エクセルは2002です) 以上、よろしくお願いします。

  • 「dbf」「csv」などをマクロで「xls」に一括変換する方法

     お世話になっております。 タイトルの通りの質問なのですが、拡張子「dbf」「csv」などのエクセルで開けるファイルをマクロで「xls」に一括変換する方法が分からなかったので質問させていただきました。 まずやり方としてなのですが、 1:「dbf」もしくは「csv」ファイルをフォルダから選び開く。 2:何も変更せずにファイル→名前を付けて保存ボタン 3:ファイル名を変更せずに保存拡張子を「Microsoft Office Excel ブック(*.xls)」に変更し保存。 4:Excelブックを変更や保存せずに閉じる。 これだけの事なのですが、流石に200個ほどあるのでマクロで出来ないものかと思いまして質問させていただきました。 ・マクロを実行するとフォルダ選択にいき、新しく「xls」に変更したいファイルを選択し、実行すると「xls」が出来ている。と言うのが理想なのですが、そのような事は可能なのでしょうか? ・1つのフォルダに様々な箇所から集めた「dbf」や「csv」をまとめてありますので、どのファイルを選択するかの時に複数個選択出来ると非常に助かります。 ・「dbf」と「csv」両方対応していなくてもどちらかだけでも、構いません。 よろしくお願いします。

  • 複数のCSVファイルを一つのブックに

    エクセルvbaの達人の皆様、どうか助けてください。 フォルダ内の複数のCSVファイルを一つのブックにシートを分けて取り込むvbaが知りたいです。問題は、 ・複数のcsvを一気に取り組みたい ・一つのブックに、csvファイル別にシートを分けたい ・文字化けを何とかしたい!!(文字コードをutf8にしたい) この3つをクリアすることですが、、 ネットで調べてみたところ、あるページに載っている以下のマクロを試してみたのですが、やはり文字化けしてしまいます。文字コードの設定をどこかで指定しなければならないと思いますが、どう改良すればよろしいでしょうか。(ちなみに、VBAは全くの初心者です) Sub test() Dim myObj As Object Dim myDir As String Dim myFileName As String Dim myc As Long Application.ScreenUpdating = False Set myObj = CreateObject("Shell.Application"). _ BrowseForFolder(0, "取り込むフォルダを選択してください", 0) If myObj Is Nothing Then Exit Sub myDir = myObj.Items.Item.Path If Right(myDir, 1) <> "\" Then myDir = myDir & "\" 'フォルダ内のExcelファイルを確認 myFileName = Dir(myDir & "*.csv") myc = 0 Do While myFileName <> "" Workbooks.Open (myDir & myFileName) myc = myc + 1 Workbooks(myFileName).Worksheets(1).Move ThisWorkbook.Worksheets(1) myFileName = Dir() Loop If myc = 0 Then MsgBox "CSVファイルがありません。" End If Application.ScreenUpdating = True End Sub (上記のマクロはhttp://www.excel.studio-kazu.jp/kw/20110705155353.html#commentから引用しました。)

  • エクセルマクロで、他ブックからオートフィルタ抽出

    エクセルで別ブックで作成してあるカレンダーから、稼働日を判断して指定した期間の日付をオートフィルターを使って抽出したいのですが、うまくいきません。 このようなコードを記述しましたが、別ブックでオートフィルターを使用する事はできるのでしょうか? Dim book1 As Workbook '変数book1をワークブック型で宣言 Dim book2 As Workbook '変数book2をワークブック型で宣言 Dim today As Date Set book1 = Application.ActiveWorkbook 'アクティブになっているブックをbook1へセット Application.ScreenUpdating = False '画面の更新を止める '↓アドレスのブックを開く事までbook2にセット(ReadOnly:=Trueで読み込み専用) Set book2 = Application.Workbooks.Open("\\sv\C1\\稼働日カレンダー.xls", ReadOnly:=True) today = Date maxdate = cdate("2014/3/3") ' book2.Worksheets("DATA").Cells.Copy Destination:=book1.Worksheets("Sheet1").Range("A1") '----オートフィルタでデータを抽出 With book2.Worksheets("Sheet1").Range("A1").CurrentRegion .AutoFilter .AutoFilter Field:=1, Criteria1:=">=" & today, Operator:=xlAnd, Criteria2:="<=" & maxdate ' .AutoFilter Field:=2, Criteria1:="=" & 1 '----抽出データをコピー&貼り付け .Copy ActiveSheet.Range("A" & maxrow) .AutoFilter End With ' Range("A1").Select Application.ScreenUpdating = True Set book1 = Nothing '変数book1を開放 book2.Close SaveChanges:=False 'book2を閉じる(SaveChanges:=Falseで保存せずに終了) Application.ScreenUpdating = True '画面の更新を再開する Set book2 = Nothing '変数book2を開放

  • 他のブックのマクロを呼び出すと他のブックの画面がアクティブになってしまう。

    エクセルのツールバーにボタンを2つ作って他のブック1,2のマクロをそれぞれ割り当てました。 エクセルの表を開いておいてツールバーから マクロ1(編集・出力)を呼び出すとブック1がアクティブになってしまい真っ白のシートが見えてしまいます。 もう一方のブック2のマクロ2はフォームを表示するマクロですがそちらはバックに隠れています。 以前同様にシート上のCH(13)を消すマクロを使っていた時もバックに隠れていました。 Application.ScreenUpdating = Falseを入れましたが一瞬ですがやはりアクティブになります。 見た目も悪いので表示したくないし、ブック1と2で動作が違う理由がわかりません、 マクロ1はこれです。 ブック1のcreateというマクロを使うのが目的です。 Sub Output() Application.ScreenUpdating = False Call create MsgBox "完了しました。" ThisWorkbook.Close End Sub マクロ2 Sub Form_Open() Frm_Form1.Show vbModeless End Sub つまらない質問ですが気になるのでよろしくお願いします。

  • シートを別のブックに複数自動コピー

    初質問です。よろしくお願いします。 マクロを使って、あるブックのシート(20から50枚程度)を、別の貼り付け先のブックに自動的にコピーしようとすると、10回をすぎたあたり(必ずしも一定せず)で 「実行時エラー'1004': WorksheetクラスのCopyメソッドが失敗しました。」 というエラーと共にマクロが止まり、デバッグしようとすると 「ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート")」 のところで止まっています。 マクロの記述内容は以下の通りです。 Sheets("貼り付け元シート").Activate ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート") Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("A1").Select Windows("貼り付け元ブック.xls").Activate ・・・以下貼り付け元シートを変えつつ複数回繰り返し これができる様になれば非常にラクになるので、ぜひご教授願います。

  • 他のブックからシートをコピーする

    ExcelVBA勉強中の者です。 他のブックのsheet1をコピーし、使用中のブックのsheet1にペーストする事を目的に ネットの情報を参考に以下のコードを作成しました。 Sub test() Dim book1 As Workbook '変数book1をワークブック型で宣言 Dim book2 As Workbook '変数book2をワークブック型で宣言 Set book1 = Application.ActiveWorkbook 'アクティブになっているブックをbook1へセット Application.ScreenUpdating = False '画面の更新を止める '↓アドレスのブックを開く事までbook2にセット(ReadOnly:=Trueで読み込み専用) Set book2 = Application.Workbooks.Open("C:\Documents and Settings\AAA\デスクトップ\他のブック.xls", ReadOnly:=True) book2.Sheets("Sheet1").Copy after:=book1.Worksheets("sheet1") Set book1 = Nothing '変数book1を開放 book2.Close SaveChanges:=False 'book2を閉じる(SaveChanges:=Falseで保存せずに終了) Application.ScreenUpdating = True '画面の更新を再開する Set book2 = Nothing '変数book2を開放 End Sub 動作としては上手くいったのですが、 book2.Sheets("Sheet1").Copy after:=book1.Worksheets("sheet1") の部分でペースト先を変数book1のsheet1と指定しているにも関わらず sheet1(2)という新しいシートが作成され、そちらへペーストしてしまいます。 思うに「コピーしたシートを挿入する」という動作であると思われますが、 これをペーストするという表記が出来ず困っております。 お手数お掛けしますがどなたかご助力お願い致します。 *Excelのバージョンは2002を使用しております。

  • 各ブックの集計値を自動的に他のブックに総合計として表示させたい。

    エクセルで各ブックの集計値を他のブックに集計したいのですが、フォルダを移動させると数値が違ってしまう。どうすればいつ見ても正しい集計値を見れるか教えて下さい。 現在1つのファイルの中にある、ブック1・2・3にそれぞれ数値を入力して合計値をブック3の別シートに合計表示させていますが、同じブックのシート間の集計ではないため、毎回数値が変わってしまい、その都度計算式を(=ブック1 D60+ブック2 d80+・・・など)を入れなおしています。 間違いなく集計できる方法を教えて下さい。ちなみに全くの初心者なので細かく説明していただけると有難いです。 VBAで検索して下記を見つけ、セル範囲やシート名など変更して試してみましたが、内容がよくわからないため 変な数字がでてきました。初心者にはやはり無理でしょうか? Sub Test() Dim MyName As String, wb As Workbook On Error Resume Next MyName = Dir(ThisWorkbook.Path & "\*.xls", vbNormal) Do While MyName <> ""   If UCase(MyName) <> UCase(ThisWorkbook.Name) Then    Application.ScreenUpdating = False    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & MyName)    ThisWorkbook.Worksheets("Sheet1").Range("A65536").End(xlUp) _      .Offset(1, 0).Value = wb.Worksheets("物件").Range("d90:k90").Value    wb.Close   End If   MyName = Dir Loop Application.ScreenUpdating = True End Sub