データがエクセルファイルなのでここで質問いたします.
エクセルファイルが300個ぐらいあります.
この中で基本になるファイルは50個ぐらいあります.
その50個のファイルの1つと残り250個ぐらいのファイル内データを比較できる方法はないでしょうか?
当然一気に比較する方法ではなくてもかまいません.
現在1つ1つ開いて見て比較する途方もない作業で死にそうです.
ファイル内データはマクロもなければ計算式すらありません.
数字データがA1~A90,B1~B90まで入っています.
データ数は全ファイル共通となっています.
どなたか良い知恵を授けてください.お願いします.

このQ&Aに関連する最新のQ&A

A 回答 (3件)

とりあえず、ファイル名固定と考えて、VBAを使わずに行うのなら、リンク貼り付けを利用すればいいですね。



1:ファイルを新規作成する。(以下、[比較1])

2:基本となるファイル(50個ほどあるやつ)を一つ開く(以下、[基準1])

3:比較対象のファイル(250個の方)をとりあえず一つ開く(以下、[対象1]

4:[基準1]のA1:B90 の範囲をコピーし、[比較1]のA2:B91にでもリンク貼り付けします。(A2を選択して、[編集]-[形式を指定して貼り付け]-[リンク貼り付け]) A1のセルには、適当にキャプションを付ける。

5:[対象1]のA1:B90をコピー、[比較1]のG2:H91にでもリンク貼り付けする。

6:次の比較対象のファイル[対象2]を開き、A1:B90を[比較1]のI2:J91にリンク貼り付けする。
以下同様に他の比較対象ファイルも処理する。
列が足りなくなったら、Sheet2にでも貼り付けする。この際、Sheet1と同じレイアウトにしておくと、何かと楽。

****ここまでは準備。 ここから比較作業****

7:G列を選択し、書式-条件付書式で、「数式が」「=(G1<>$A1)」を指定し、目立つような書式(例えば背景が赤とか)を設定する。

8:同様に、H列も「数式が」「=(H1<>$B1)」にして、条件付書式を設定。

9:G:Hを選択し、コピー、I:J列を選択し、「形式を指定して貼り付け」で書式のみを貼り付ける。同様にG:Jの書式をK:Nに貼り付けて・・以下同様

以上の操作で、基準データと異なるものだけがハイライト表示されるはずです。

それとか、C2のセルに
=(A2<>G2)+(A2<>I2)+(A2<>K2)+・・・
ってすると、A2と異なるデータの個数が求められますね。

10:このファイルを複製して、他の基準データに対応したものも作成する。[比較2],[比較3](A列、B列のデータだけ変えればいいです。)



これで解決できますか?何かあったら、補足してください。
    • good
    • 0
この回答へのお礼

ありがとうございます.
すごいです.
DOSレベルで簡単に考えてましたが
エクセルのファイル比較はこのようにやるのですか.
参考させていただきます.

お礼日時:2001/07/27 14:38

前の回答と同様の前提です。


横に50余りのBook、縦に250余りのBookのSheet1のセル内容を取り込みます。AB列それぞれで比較しています。
各シートの差の絶対値を計算・表示し、シート単位のA・B列の絶対値計を計算し、ゼロでなければ青く色が付きます。

実際、300余りのBookでどの位時間がかかるか不明です。300Bookを一括処理が可能かも不明です。
基本3Book、比較対象6Bookで数秒です。(こちらはPentium120、32MB (;o;)とかなり遅い! )
数Bookでテストして見て下さい。けっこうおもしろい問題でした。

標準モジュールに貼り付けます。
Public Sub SheetsHikakuCell()
 Dim MainFolder As String, MainExcel As String, MainBookNum As Integer ' 50シートのフォルダ,ファイル名,数
 Dim Sub_Folder As String, Sub_Excel As String, Sub_BookNum As Integer '250シートのフォルダ,ファイル名,数 '

 Dim myBookName As String '集計用ブック名
  myBookName = ThisWorkbook.Name
 Dim sht1 As Worksheet '集計用シート
 Dim rg As Range '集計用シートのA1
 Set sht1 = Worksheets("Sheet1")
 Set rg = sht1.Range("A1")

 MainFolder = "C:\benkyo\Main" '<=== 変更して下さい
 Sub_Folder = "C:\benkyo\Sub" '<=== 変更して下さい

 Application.ScreenUpdating = False

 ' 50シートの方を読む。
 MainExcel = Dir(MainFolder & "\" & "*.xls")
 While MainExcel <> ""
  Workbooks.Open MainFolder & "\" & MainExcel
   MainBookNum = MainBookNum + 1

   Workbooks(myBookName).Activate
    With Worksheets("Sheet1").Range("A1")
     .Offset(0, MainBookNum * 4) = MainExcel
     Workbooks(MainExcel).Worksheets("Sheet1").Range("A1:B90").Copy _
       Destination:=.Offset(0, MainBookNum * 4 + 1)
    End With
    Workbooks(MainExcel).Close

  MainExcel = Dir
 Wend

 '250シートの方を読む。
 Sub_Excel = Dir(Sub_Folder & "\" & "*.xls")
 While Sub_Excel <> ""
  Workbooks.Open Sub_Folder & "\" & Sub_Excel
   Sub_BookNum = Sub_BookNum + 1

   Workbooks(myBookName).Activate
    With Worksheets("Sheet1").Range("A1")
     .Offset(Sub_BookNum * 100, 0) = Sub_Excel
     Workbooks(Sub_Excel).Worksheets("Sheet1").Range("A1:B90").Copy _
       Destination:=.Offset(Sub_BookNum * 100, 1)
    End With
    Workbooks(Sub_Excel).Saved = True
    Workbooks(Sub_Excel).Close

  Sub_Excel = Dir
 Wend

 Dim rwCot As Integer
 With Worksheets("Sheet1").Range("A1")
  'ファイル名のコピー
  .Offset(100, 4).Formula = "=E1"
  'A列の差額計算式
  For rwCot = 1 To 90
   .Offset(99 + rwCot, 5).Formula = "=Abs(F$" & rwCot & "-$B" & (100 + rwCot) & ")"
  Next
  'B列の差額計算式
  For rwCot = 1 To 90
   .Offset(99 + rwCot, 6).Formula = "=Abs(G$" & rwCot & "-$C" & (100 + rwCot) & ")"
  Next
  'A列差の絶対値計
  .Offset(102, 4) = "A列差の絶対値計"
  .Offset(103, 4).Formula = "=Sum(F101:F190)"
  .Offset(103, 4).FormatConditions.Delete '条件付き書式を設定
  .Offset(103, 4).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="0"
  .Offset(103, 4).FormatConditions(1).Interior.ColorIndex = 8
  'B列差の絶対値計
  .Offset(105, 4) = "B列差の絶対値計"
  .Offset(106, 4).Formula = "=Sum(G101:G190)"
  .Offset(106, 4).FormatConditions.Delete '条件付き書式を設定
  .Offset(106, 4).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="0"
  .Offset(106, 4).FormatConditions(1).Interior.ColorIndex = 8
 End With

 '差額の式をコピー
 Dim mn, sb As Integer 'Bookカウンタ
 Range("E101:G190").Copy
 For mn = 1 To MainBookNum
  For sb = 1 To Sub_BookNum
   Range("E101").Offset((sb - 1) * 100, (mn - 1) * 4).Select
   ActiveSheet.Paste
  Next
 Next

 Application.ScreenUpdating = True

End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます.
プログラムも書いて頂き
大変恐縮です.
うまく行きそうです.

お礼日時:2001/07/27 14:42

>ファイル内データを比較できる方法はないでしょうか?


この意味はセル単位で比較し、セル単位に差額を表示したりすることでしょうか。それも一応作りましたが・・・まだ未完成。

下記は、シート50余りと、250余りのシートのAB列の内容を比較し、シート単位で一致しているか判定を表示します。質問の意味と異なっていれば補足してください。それから、比較結果の出力方法も補足してもらえればと思います。

前提  50余りのシートを1つのフォルダに集めます。
      MainFolder = "・・・・・・" をそのドライブ、フォルダにします。
   250余りのシートを1つのフォルダに集めます。(50余りとは別フォルダ)
      Sub_Folder = "・・・・・・" をそのドライブ、フォルダにします。
   比較対象のブック以外は入れないで下さい。
   各データはSheet1(シート名)に入っていると仮定しています。

出力 横に50余りのシート名、縦に250余りのシート名を表示してA,B列毎に
   一致していれば『○』、異なっていれば『×』を表示します。

なにせシート数が多いので数シートずつにしてテストして見て下さい。 

標準モジュールに貼り付けて下さい。

Public Sub SheetsHikaku()
 Dim MNdt() As Double ' 50シートの方の値
 Dim SBdt(1, 90) As Double '250シートの方の値
 Dim Sagaku(2) As Double 'A,B列の差
 Dim rw, cl, bk As Integer '行,列,ブックのカウンタ
 Dim MainFolder As String, MainExcel As String, MainBookNum As Integer ' 50シートのフォルダ,ファイル名,数
 Dim Sub_Folder As String, Sub_Excel As String, Sub_BookNum As Integer '250シートのフォルダ,ファイル名,数 '
 Dim myBookName As String '集計用ブック名

 Dim sht1 As Worksheet '集計用シート
 Dim rg As Range '集計用シートのA1
 Set sht1 = Worksheets("Sheet1")
 Set rg = sht1.Range("A1")

 MainFolder = "C:\benkyo\Main" ' <=== 変更して下さい
 Sub_Folder = "C:\benkyo\Sub" ' <=== 変更して下さい
 myBookName = ThisWorkbook.Name

 Application.ScreenUpdating = False

 ' 50シートの方を読む。MNdt()に格納
 MainExcel = Dir(MainFolder & "\" & "*.xls")
 While MainExcel <> ""
  Workbooks.Open MainFolder & "\" & MainExcel
   MainBookNum = MainBookNum + 1
   rg.Offset(0, (MainBookNum - 1) * 2 + 1) = MainExcel '表題を書く
   rg.Offset(1, (MainBookNum - 1) * 2 + 1) = "A列"
   rg.Offset(1, (MainBookNum - 1) * 2 + 2) = "B列"

   ReDim Preserve MNdt(1, 90, MainBookNum)
   With Workbooks(MainExcel).Worksheets("Sheet1").Range("A1")
    For cl = 1 To 2
     For rw = 1 To 90
      MNdt(cl - 1, rw, MainBookNum) = .Offset(rw - 1, cl - 1)
     Next
    Next
   End With
  Workbooks(MainExcel).Close

  '次のブック
  MainExcel = Dir
 Wend

 '250シートの方を読む。SBdt()に格納
 Sub_Excel = Dir(Sub_Folder & "\" & "*.xls")
 While Sub_Excel <> ""
  Workbooks.Open Sub_Folder & "\" & Sub_Excel
   Sub_BookNum = Sub_BookNum + 1
   rg.Offset(Sub_BookNum + 1, 0) = Sub_Excel '表題を書く
   With Workbooks(Sub_Excel).Worksheets("Sheet1").Range("A1")
    For cl = 1 To 2
     For rw = 1 To 90
      SBdt(cl - 1, rw) = .Offset(rw - 1, cl - 1)
     Next
    Next
   End With
  Workbooks(Sub_Excel).Close

  'データの比較
  For bk = 1 To MainBookNum
   For cl = 1 To 2
    Sagaku(cl) = 0
    For rw = 1 To 90
     Sagaku(cl) = Sagaku(cl) + Abs(MNdt(cl - 1, rw, bk) - SBdt(cl - 1, rw))
    Next
    If Sagaku(cl) > 0 Then '比較結果を書く
     rg.Offset(Sub_BookNum + 1, (bk - 1) * 2 + cl) = "×"
    Else
     rg.Offset(Sub_BookNum + 1, (bk - 1) * 2 + cl) = "○"
    End If
   Next
  Next

  '次のブック
  Sub_Excel = Dir
 Wend

 Application.ScreenUpdating = True

End Sub
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセル内で複数の文字(50個ぐらい)を一括で検索したい

タイトル通りなのですが、エクセル内の文字列で
特定の複数(50個ぐらい)の文字を一括検索したいのですが、
どうすれば 検索できますか?
決して検索後に、別の文字に置き換えや、
複数のエクセルを一括検索したいとまでは言いません。
一つのエクセル内で複数(50個ぐらい)の文字を検索し、
ヒットしてくれれば 後はヒットした文字列を手動で
削除していくので、検索できるだけで構わないです。

もちろん 贅沢を言えば、ヒットした文字列の
文字色or文字列の枠内か枠が色付きになってくれると
ひと目でヒットしている場所が分かり、助かるのは
事実ですが、簡単に できる方法ってありますか?
複雑なマクロを使うことになるのでしょうか?

どなたかご存知のかたがいらっしゃれば
教えていただけないでしょうか?

なにぶん無知なほうなので、面倒かと思いますが、
具体的に教えていただけると幸いに思います。
どうぞよろしくお願い致します。

Aベストアンサー

No2 merlionXXです。

> 検索したい複数の文字は どこに設定すれば よろしいでしょうか?

「A1セルからA50セルまでの各セルにそれぞれ検索したい文字があるとします。」と書いておいたのですが、意味が伝わらなかったのでしょうか?
A1からA50まのの各セルに設定してください。
なお、検索範囲はマクロ実行前に選択(セレクト)しておいてくださいね。

> 後、例:16F~70Fなど、範囲を決めての英数字の検索等も可能ですか?

では、16F~70Fを検索するマクロです。

Sub 連続検索02()
For n = 16 To 70 '16~70まで
Set c = Selection.Find(What:=n & "F", LookAt:=xlPart) '選択範囲を検索(16F~70F)
If Not c Is Nothing Then 'あったら
fAd = c.Address 'セル番地を控える
Do '繰り返す
i = i + 1 'カウント
c.Interior.ColorIndex = 8 'セル着色
Set c = Selection.FindNext(c) '連続検索
Loop Until c.Address = fAd '一巡するまで'繰り返し
End If
Next n '次の検索文字で繰り返す
Set c = Nothing
MsgBox i & "件を発見しました。", vbInformation, " ( ̄ー ̄)v"
End Sub

No2 merlionXXです。

> 検索したい複数の文字は どこに設定すれば よろしいでしょうか?

「A1セルからA50セルまでの各セルにそれぞれ検索したい文字があるとします。」と書いておいたのですが、意味が伝わらなかったのでしょうか?
A1からA50まのの各セルに設定してください。
なお、検索範囲はマクロ実行前に選択(セレクト)しておいてくださいね。

> 後、例:16F~70Fなど、範囲を決めての英数字の検索等も可能ですか?

では、16F~70Fを検索するマクロです。

Sub 連続検索02()
For n =...続きを読む

Qエクセルで自動で1.2.3.......50と数字を入力させたい

エクセルで数字を打つのに下方向に1.2.3.4.5.....50と自動で打たせたいのですが、何か自動する方法はないでしょうか??

Aベストアンサー

 
セルA1に「1」、セルA2に「2」、セルA1とA2を選択した選択した範囲の左下にある■を下方向にドラッグすれば50でも1000でも数秒で完了です。

他の方法は、数字を初めたいセルをクリックした後で、ツールバーの「編集」から「フィル」-「連続データの作成」を押して「増分値」を「1」、停止値を「50」「範囲」を列にして「OK」を押す。

 

Qエクセル スクロールバーにて変わる値について、現在と1個前のデータを比較したい

スクロールバーを動かすことによって次々と変わる値があるとします。今、スクロールバーを動かす前の値をコピーし、その後にスクロールバーを動かして新しい値を表示させ、一個前の値と比較したいと思っています。当初、「値のコピー→スクロールバーを動かす」というマクロをつくり、そのマクロをスクロールバーにリンクさせればいいのかと思ったのですが、スクロールバーを動かした後の値がコピーされ、1個前の値がコピーされません。どうすればよろしいでしょうか。最終的には、現在、1個前、2個前との比較を同時にしたいと思っております。よろしくお願いいたします。

Aベストアンサー

ツール→マクロ→VisualBasicEditorを起動して
プロジェクトエクスプローラから標準モジュールを表示すると
Macro1があると思います。
仮にあなたが=random云々を入力記録したセルをA1と仮定すると

その中身を消して

Range("F65536").End(xlUp).Offset(1, 0).Formula = Range("A1")

とすればボタンを押すつどF列に記録が溜まっていきます。

{別のセルなら最後のRange("A1")を変更してみてください。}

QエクセルVBAで、開いているファイルAへファイルBで選択したデータをコピーする方法について。

エクセル2013のVBAで、開いているファイルBの選択した範囲から、同じく開いているファイルAの選択箇所へ選択した範囲のデータをコピーしようとしているのですが、どうやっても下記の「エラー箇所」で"インデックスが有効範囲にありません"というメッセージでエラーとなります。
何かアドバイスを教えてもらえると助かります。

Sub try01()
Dim WBK_b As Workbook
Dim objSheet_b As Worksheet
Dim Range_b, Range_a As Range
Dim Name_a, Name_b
Dim RStart_b, GStart_b, GEnd_b, RStart_a, GStart_a

'Aファイルのセルを選択
Set Range_a = Application.InputBox("セルを選択せよ ", Type:=8)
Name_a = Range_a.Worksheet.Name
GStart_a = Selection.Row

'Bファイルで範囲を選択
Set Range_b = Application.InputBox("セルを選択せよ ", Type:=8)
Name_b = Range_b.Worksheet.Name

Set WBK_b = ActiveWorkbook
Set objSheet_b = WBK_b.Worksheets(Name_b) '「エラー箇所」

Sheets(Name_b).Select
Sheets(Name_b).Range_b.Select

GStart_b = Selection.Row
GEnd_b = Selection(Selection.Count).Row

End Sub

エクセル2013のVBAで、開いているファイルBの選択した範囲から、同じく開いているファイルAの選択箇所へ選択した範囲のデータをコピーしようとしているのですが、どうやっても下記の「エラー箇所」で"インデックスが有効範囲にありません"というメッセージでエラーとなります。
何かアドバイスを教えてもらえると助かります。

Sub try01()
Dim WBK_b As Workbook
Dim objSheet_b As Worksheet
Dim Range_b, Range_a As Range
Dim Name_a, Name_b
Dim RStart_b, GStart_b, GEnd_b, RStart_a, GStart_...続きを読む

Aベストアンサー

codedreamさんのコードをExcel2010で実行してみましたが、
「エラー箇所」でエラーを発生させることができませんでした。
環境の違いによるものであれば、この回答は読み捨ててください。

codedreamさんのやりたいことは、シートAの選択範囲AをシートBの選択範囲Bへ
コピーする(シートAとシートBは別ブック)ということですよね。
これを実現するには、マクロの実行中に、アクティブブックを切り替える必要があります。
しかし、私の環境では、ブックの切り替えができませんでした。(シートの切り替えはできました)
よって、ブックA、ブックB、および、アクティブブックは、すべて同じブックとなってしまいます。

「エラー箇所」でエラーを発生させるには、アクティブブック内に、シートBがない状況を
作る必要があります。しかし、アクティブブックはシートBと同じブックなので、当然、
シートBは存在します。よって、「エラー箇所」でエラーにはなりませんでした。
実際にエラーが発生したのは、2行下の Sheets(Name_b).Range_b.Select でした。

マクロ実行中にアクティブブックの切り替えができない限り、ブック間のコピーは
不可能と思います。(同一ブック内のシート間であれば、可能かもしれません)

codedreamさんのコードをExcel2010で実行してみましたが、
「エラー箇所」でエラーを発生させることができませんでした。
環境の違いによるものであれば、この回答は読み捨ててください。

codedreamさんのやりたいことは、シートAの選択範囲AをシートBの選択範囲Bへ
コピーする(シートAとシートBは別ブック)ということですよね。
これを実現するには、マクロの実行中に、アクティブブックを切り替える必要があります。
しかし、私の環境では、ブックの切り替えができませんでした。(シートの切り替えはできま...続きを読む

Q100個のエクセルのファイルを1個のファイルに

教えてください。
100個のエクセルファイルが有るのです。
これを1のファイルにタブを100個にしたものを作りたいのですが、手作業で行うととても時間がかかります。
何か良い方法は有りませんでしょうか。
よろしく御願いします。

Aベストアンサー

こんにちは

探せばその手のソフトが見つかるかもしれないですね。
http://oshiete1.goo.ne.jp/qa5287571.html

では。


このカテゴリの人気Q&Aランキング

おすすめ情報