曜日毎の利用者を絞り込んで表示

質問

以前、質問7241791にて回答を得ました。

http://okwave.jp/qa/q7241791.html

データ数が少ないうちはサクサクと動いたいたのですが、多くなるにつれ、データ作業が重くなり、
現在40近くのデータを入れると、メモリ不足となる上、ファイルサイズも20MBとなっています。

作業が重すぎてしまい・・・せっかく教えていただいたのに、うまく活用できていません。

作業を軽くする効率的な方法がありましたら、アドバイスいただければと思います。
よろしくお願いいたします。

回答No.1

keithin · ベストアンサー

回答の数式は９人分（合計１０行分）のデータ件数で書かれていますが，人数が増えていま実際にアナタが使っている数式は，回答の式をいったい全体具体的に「どんな式に直して」使っているのですか？
問題が起きているときは，アナタが実際に使っているエクセルの「今の数式（今の姿）」を，キチンと具体的に目に見えるようにご相談で情報提供するようにしてください。

やること１：
数式を
=INDEX($A:$A,SMALL(IF(B$2:B$10,ROW(B$2:B$40),999),ROW(I1)))&""
に直してＣｔｒｌ＋Ｓｈｉｆｔ＋Ｅｎｔｅｒで入れ直し，右に金曜日までコピーし，更に下に最大４０行までコピー貼り付ける。

やること２：
シートを開く
キーボードでCtrl+Endを押す（コントロールキーを押しながらEndキーを押す）
シートの「最後のセル」にジャンプするので，いったいどこまで飛んでいったか確認する
例えばＬ１００セルまでジャンプしたとする

その最後のセルの行（１００行）から，いまシートで実際に使っている行（４２行ぐらい）までを，行番号の所をクリックして「行選択」する
さらに行番号の所で右クリックして，行を削除する
必ず一度ブックを保存し，閉じて，開き直す

もういちどCtrl+Endを押し，今度は最後のセルが実際に使っている４２行目の行で納まっているかキチンと再確認する
出来てないときは，できるまで手順をやり直す。

お礼

回答ありがとうございました。
私も焦っていて、keithin様の回答を見て見落としに気付きました。

行数を50行で、それ以降を非表示にしておりましたが、オートフィルドラッグコピーの際に、最終行を含んでいたため、実際には50行ではなく、endまで続いていたためにこの現象が発生しておりました。

非表示を再表示させ、不要の行の数式を削除したのち、再度非表示とすることで、解決しました。

皆様へのお礼をこの場でさせていただきます。
早とちりで申し訳ございませんでした。回答ありがとうございました。

回答No.3

KURUMITO

配列数式を使って処理するよりも作業列を作ってできるだけ簡単な関数を使って処理することが作業を軽くするうえで必要なことでしょう。
例えばＵＲＬにお示しの表でＨ2セルには次の式を入力してＬ2セルまで横にオートフィルドラッグコピーしたのちに下方にもオートフィルドラッグコピーします。

=IF(B2=1,SUM(B$2:B2),"")

元の表がシート1に有りお求めの表を例えばシート2に表示させるとしたら、シート2のＡ1セルからＥ1セルには月曜から金曜までを入力します。
Ａ2セルには次の式を入力してＥ2セルまでオートフィルドラッグコピーした後に下方にもオートフィルドラッグコピーします。

=IF(COUNTIF(Sheet1!H:H,ROW(A1))=0,"",INDEX(Sheet1!$A:$A,MATCH(ROW(A1),Sheet1!H:H,0)))

回答No.2

tom04

こんばんは！
横からお邪魔します。

前の質問を見させていただきました。
＞現在40近くのデータを入れると・・・
とありますが、配列数式を使ってもその程度だとそんなに問題ないような感じがします。

でも実際問題として重いというコトであれば、VBAでの一例です。
Sheet1に元データがありSheet2に表示するとします。
セル配置は前の質問にアップされている画像通りだとします。

Sheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面がでますので
↓のコードをコピー＆ペーストしてSheet1のデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
If Intersect(Target, Range("B:F")) Is Nothing Then Exit Sub
Dim i, j As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
Application.ScreenUpdating = False
i = ws.UsedRange.Rows.Count
If i > 1 Then
ws.Rows(2 & ":" & i).ClearContents
End If
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To 6
If Cells(i, j) = 1 Then
ws.Cells(Rows.Count, j - 1).End(xlUp).Offset(1) = Cells(i, 1)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

お役に立ちますかね？
どうも失礼しました。m(_ _)m