みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel シート毎の比較、抽出

教えて頂きたい事が、二つあります。

sheetの名前が
「合計」「レモン」「みかん」「オレンジ」「ブドウ」「ひな形」とあります。

(1)各果物のSheetのセル(R7C6)に売上率が書いています(数値)
 各果物のSheet毎に売上率を比べて
 「合計」Sheetの同位置のセル(R7C6)に、一番高い売上率を表示させたい。



(2)もう一つは
 各果物のSheetのあるセル(R7C7)に色が書いてあります(文字列)
 書いてないこともあります。
 「合計」Sheetの同位置のセル(R7C7)に各Sheetより抽出したデータを
 表示させたい。

 
 例えば
   Sheet 「レモン」「みかん」「オレンジ」「ブドウ」「ひな形」
   R7C7    黄    紫   (空欄)   群青  (空欄)

   でSheet「合計」セル(R7C7)に
        [黄 紫 群青]
   と言うような具合。

  「=レモン!R7C7&" "&みかん!R7C7&" "&オレンジ!R7C7&" "&ブドウ!R7C7」
   とすると、スペース分が出てしまい、綺麗に表示されません。


今後フルーツが増えていく予定
(「合計」「レモン」「みかん」「オレンジ」「ブドウ」「メロン」「ひな形」)
(「合計」「レモン」「みかん」「オレンジ」「ブドウ」「りんご」「メロン」「ひな形」)
(「合計」「パイナップル」「レモン」「みかん」「オレンジ」「ブドウ」「りんご」「メロン」「ひな形」)
なので間(合計が先頭でひな形が一番後ろ)に新しいsheetが入っても、対応できるような式がいいのですが・・・

投稿日時 - 2006-02-01 13:07:22

QNo.1936061

困ってます

質問者が選んだベストアンサー

(1)Book内の総シート数Cntの設定のコーディングがなくなっています。このため、For i=1 To Cnt のループが1回も実行されません。結果、売り上げは0 色は空欄となります。

(2)最大売上を最小値0に、また、色を空っぽにするのは、行のループ内です。

(3)処理しないシート名が「レモン」と「ひな型」以外になっています。「レモン」でなく「合計」だと思います。

およそ500行で「レモン」~「ぶどう」の4シートで5秒くらいかかりますね(私のPCだと)。シートが増えるとかなり動作が遅くなりそうな。

Sub Uriage()

Dim SaidaiUriage As Long
Dim UriageIroGyo As Integer
Dim UriageRetu As Integer
Dim Iro As String
Dim IroRetu As Integer
Dim Cnt, i As Integer

UriageRetu = 6
IroRetu = 7

'Book内の総シート数 (1)の指摘事項
Cnt = Worksheets.Count

For UriageIroGyo = 7 To 501
'最大売上を最小値0に、また、色を空っぽにする (2)の指摘事項
SaidaiUriage = 0
Iro = ""

'各シートの同一行を比較し、最大売上と色を求める
For i = 1 To Cnt
'(3)の指摘事項
If Not ((Worksheets(i).Name = "合計") Or (Worksheets(i).Name = "ひな形")) Then
'売上の大きいのはどちらか
If (Worksheets(i).Cells(UriageIroGyo, UriageRetu).Value > SaidaiUriage) Then
SaidaiUriage = Worksheets(i).Cells(UriageIroGyo, UriageRetu).Value
End If

'色取得
If Not IsEmpty(Worksheets(i).Cells(UriageIroGyo, IroRetu).Value) Then
Iro = Iro & " " & Worksheets(i).Cells(UriageIroGyo, IroRetu).Value
End If

End If
Next i

Worksheets("合計").Cells(UriageIroGyo, UriageRetu).Value = SaidaiUriage
Worksheets("合計").Cells(UriageIroGyo, IroRetu).Value = Iro

Next UriageIroGyo

End Sub

投稿日時 - 2006-02-08 21:17:40

お礼

できました!感動です (T T)
なんも知らない自分に
ホントにありがとうございます。

投稿日時 - 2006-02-09 08:24:23

ANo.5

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.4

No.1です。
細かなことは長くなるので、ご自身のコーディングと比較して見てください。

MORICKさんの作られた構想は、1つのシート内の有効な行でループし売上を取得。次のシートに移り、先ほどのシートの売上と行ごとに比較し最大を求める。これをシート数分繰る返すとなっています。
この場合、全シートでの処理が終わらないと各行の最大売上が決まらないため、行数分の最大売上を覚えておく場所が必要です(dimで配列を定義)。で、この考えは素直な考え方です。もし、行が固定で10とか決まるのであれば、この構想でOKです。

シート内のデータの入った行数は、excelから教えてもらえないようです。rows.countは、範囲指定時の行数で指定していないと65565みたいです(本当はあるのかもしれません。私が知らないだけかも)。
そこで、基本となる行数をシート「レモン」の売上欄が空っぽでない行までとして最初に数え、1行ごとの比較を全シートで行い、シート「合計」に結果を書き込み、これを行数分繰り返す様な構想に変更しました。

あと、これはつけたしですが、イベントプロシージャー、この場合Worksheet_Activateですが、ここに直接コーディングを入れるのは、勉強するのには、余りよくないのです。そこで、本来の処理は、標準モジュールに作成し、Worksheet_Activateの中は、1行だけCALL文を入れるようにしました。動作がおかしい場合、このCALL文をコメントにしてしまえば、プログラムは動かなくなるという利点もあります。

内容は
シート合計のモジュールは
Option Explicit
Private Sub Worksheet_Activate()
Call Uriage

End Sub

標準モジュールは
Option Explicit
Sub Uriage()
'シート「合計」からWorksheet_Activateで呼び出される
'シート「レモン」の売上欄、7列目に行方向に連続で値が
'入っているものとし、各シートはその行数分処理する
'
Dim SaidaiUriage As Long
Dim UriageIroGyo As Integer
Dim UriageRetu As Integer
Dim Iro As String
Dim IroRetu As Integer
Dim Cnt, i As Integer
Dim myLastRow As Long

UriageRetu = 6
IroRetu = 7



'Book内の総シート数
Cnt = Worksheets.Count

'シート「レモン」の売上欄には、有効な行数分連続で値が
'入っているものとして
'処理行数を決定する。1行目から調べ、未入力行で終了
i = 1
While (Not IsEmpty(Worksheets("レモン").Cells(i, UriageRetu).Value))
i = i + 1
Wend

'未入力行の行番号なので処理する行より1つ多い。
'マイナス1して、処理行数とする
myLastRow = i - 1

'最大売上の取得ループ
'行数分ループ
For UriageIroGyo = 1 To myLastRow
'最大売上を最小値0に、また、色を空っぽにする
SaidaiUriage = 0
Iro = ""

'各シートの同一行を比較し、最大売上と色を求める
For i = 1 To Cnt
If ((Worksheets(i).Name = "合計") Or (Worksheets(i).Name = "ひな形")) Then
'何もしない
Else
'売上の大きいのはどちらか
If (Worksheets(i).Cells(UriageIroGyo, UriageRetu).Value > SaidaiUriage) Then
SaidaiUriage = Worksheets(i).Cells(UriageIroGyo, UriageRetu).Value
End If


'色取得
If Not IsEmpty(Worksheets(i).Cells(UriageIroGyo, IroRetu).Value) Then
Iro = Iro & " " & Worksheets(i).Cells(UriageIroGyo, IroRetu).Value
End If

End If
Next i

Worksheets("合計").Cells(UriageIroGyo, UriageRetu).Value = SaidaiUriage
Worksheets("合計").Cells(UriageIroGyo, IroRetu).Value = Iro
Next UriageIroGyo

End Sub

投稿日時 - 2006-02-02 17:47:56

補足

>シート「レモン」の売上欄、7列目に行方向に連続で値が入っているものとし、
なんですが入ってません(汗)途中空欄の行が数カ所あります。
ただ列は501行と決まってるので以下のように作ってみたのですが・・・
マクロは動いてはいるのですが、
売り上げは0 色は空欄のままです。なぜなんでしょうか・・・?




Option Explicit
Sub Uriage()

Dim SaidaiUriage As Long
Dim UriageIroGyo As Integer
Dim UriageRetu As Integer
Dim Iro As String
Dim IroRetu As Integer
Dim Cnt, i As Integer
Dim myLastRow As Long

UriageRetu = 6
IroRetu = 7


'最大売上を最小値0に、また、色を空っぽにする
SaidaiUriage = 0
Iro = ""

For UriageIroGyo = 7 To 501

'各シートの同一行を比較し、最大売上と色を求める
For i = 1 To Cnt
If Not ((Worksheets(i).Name = "レモン") Or (Worksheets(i).Name = "ひな形")) Then
'何もしない

'売上の大きいのはどちらか
If (Worksheets(i).Cells(UriageIroGyo, UriageRetu).Value > SaidaiUriage) Then
SaidaiUriage = Worksheets(i).Cells(UriageIroGyo, UriageRetu).Value
End If


'色取得
If Not IsEmpty(Worksheets(i).Cells(UriageIroGyo, IroRetu).Value) Then
Iro = Iro & " " & Worksheets(i).Cells(UriageIroGyo, IroRetu).Value
End If

End If
Next i

Worksheets("合計").Cells(UriageIroGyo, UriageRetu).Value = SaidaiUriage
Worksheets("合計").Cells(UriageIroGyo, IroRetu).Value = Iro

Next UriageIroGyo

End Sub

投稿日時 - 2006-02-08 09:16:28

ANo.3

(1)は単純に
=MAX(レモン:ひな形!RC)

(2)はシートを追加するならVBAのほうがいいですが、力技なら
=IF(レモン!RC<>"",レモン!RC,"")&IF(みかん!RC<>""," "&みかん!RC,"")&IF(オレンジ!RC<>""," "&オレンジ!RC,"")&IF(ブドウ!RC<>""," "&ブドウ!RC,"")&IF(・・・・・・

投稿日時 - 2006-02-01 23:10:43

ANo.2

No.1です。
集計をするタイミングは、合計シートをクリックした時とした場合…

1.メニューでツール→マクロ→Visial Basic Editorを選択します。VBEの画面が表示されます。
2.画面は、普通「プロジェクト-VBAProject」というタイトルのウインドウが左に表示されるはずです。
出ていなければ、VBE画面のメニューで表示→プロジェクトエクスプローラを選択します。ウインドウが表示されます。
3.プロジェクトウインドウにはフォルダーのアイコンの下にシート名のぶら下がった一覧が出ています。合計のシートをダブルクリックします。コード入力のウインドウが開きます。
4.回答のコーディングをコピーし、コード入力のウインドウに貼り付けます。

これでいいはずです。やってみてください。最初は誰でもわからないものです(^^;

Worksheet_Activateというプログラムのモジュール名は、決まり文句でそのシートが選択されたとき、excelが自動的に呼び出すものです。

集計のタイミングを自分でボタンでクリックする、あるいは、メニューのツール→マクロから選ぶのであれば
「Worksheet_Activate」を別な名前、例えば「Uriage」とかにして、標準モジュールに貼り付けていただければOKだと思います。

投稿日時 - 2006-02-01 19:17:46

お礼

できました。と言うか、できてました(汗
てっきり普通の式入力のように何か表示されるものだと思ってて。ありがとうございます。

これは他の行もする場合はどうしたらよろしいのでしょうか・・・頑張ってみたのですが動きません。



Private Sub Worksheet_Activate()
Dim SaidaiUriage As Long
Dim UriageGyo, UriageRetu As Integer
Dim Iro As String
Dim IroGyo, IroRetu As Integer
Dim Cnt, i As Integer
Dim j As Integer
Dim myLastRow As Integer

UriageGyo = j
UriageRetu = 6

IroGyo = j
IroRetu = 7

SaidaiUriage = 0
Iro = ""


'Book内の総シート数
Cnt = Worksheets.Count
myLastRow = Rows.Count

'最大売上の取得ループ
For i = 1 To Cnt
For j = 1 To myLastRow
If ((Worksheets(i).Name = "合計") Or (Worksheets(i).Name = "ひな形")) Then
'何もしない
Else
'売上の大きいのはどちらか
If (Worksheets(i).Cells(UriageGyo(j), UriageRetu).Value > SaidaiUriage) Then
SaidaiUriage = Worksheets(i).Cells(UriageGyo(j), UriageRetu).Value
End If



'色取得
If Not IsEmpty(Worksheets(i).Cells(IroGyo(j), IroRetu).Value) Then
Iro = Iro & " " & Worksheets(i).Cells(IroGyo(j), IroRetu).Value
End If

End If
Next j
Next i



Worksheets("合計").Cells(UriageGyo, UriageRetu).Value = SaidaiUriage
Worksheets("合計").Cells(IroGyo, IroRetu).Value = Iro


End Sub

投稿日時 - 2006-02-02 10:26:14

ANo.1

マクロならこんな感じです。
ここでは、計算するタイミングをシートの合計が選択された時点で行っています(シート名、合計のActivateイベントプロシージャとしてコーディングしています)。そのあたりは、調整してください(ボタンを作ってクリックした時点で計算する等)。

Option Explicit
Private Sub Worksheet_Activate()
Dim SaidaiUriage As Long
Dim UriageGyo, UriageRetu As Integer
Dim Iro As String
Dim IroGyo, IroRetu As Integer
Dim Cnt, i As Integer

UriageGyo = 7
UriageRetu = 6
IroGyo = 7
IroRetu = 7

SaidaiUriage = 0
Iro = ""

'Book内の総シート数
Cnt = Worksheets.Count
'最大売上の取得ループ
For i = 1 To Cnt
If ((Worksheets(i).Name = "合計") Or (Worksheets(i).Name = "ひな形")) Then
'何もしない
Else
'売上の大きいのはどちらか
If (Worksheets(i).Cells(UriageGyo, UriageRetu).Value > SaidaiUriage) Then
SaidaiUriage = Worksheets(i).Cells(UriageGyo, UriageRetu).Value
End If

'色取得
If Not IsEmpty(Worksheets(i).Cells(IroGyo, IroRetu).Value) Then
Iro = Iro & " " & Worksheets(i).Cells(IroGyo, IroRetu).Value
End If
End If
Next i

Worksheets("合計").Cells(UriageGyo, UriageRetu).Value = SaidaiUriage
Worksheets("合計").Cells(IroGyo, IroRetu).Value = Iro




End Sub

(字下げが表示されず大変見にくくなっています。)

投稿日時 - 2006-02-01 14:45:17

お礼

ありがとうございます。。。
なんですが、マクロを一度も使用したことがないもので・・・(汗


.メニューの「挿入」→「標準モジュール」
.標準モジュールに以下のVBAコードをコピーペーストします。
.ワークシートからメニューの「ツール」→「マクロ」→「マクロ」で、出てきたものを選択肢して、実行

とあったので見よう見まねでしましたが
このやり方でやっても「Worksheet_Activate()」が
出てこないので実行できません(涙

すいません初心者で。。。

投稿日時 - 2006-02-01 15:58:40

あなたにオススメの質問