エクセル宜しくお願いします。

質問

Ａ列はコードナンバー、Ｂ列には氏名
１行目は日付２列目は曜日３列目からは来店された時間
１時間未満なら１、３時間未満なら３と・・・（手入力）
　　　日付　７／１　７／２　７／３　７／４
　　　曜日　　木　　　金　　　土　　　日
１　Ａさん　　１　　　２　　　１　　　１
２　Ｂさん　　０　　　３　　　１　　　４
３　Ｃさん　　２　　　０　　　２　　　３
４　Ｄさん　　１　　　１　　　１　　　０
２００番まであります
それを現状はオートフィルタをつかい０を省いて１から順にコピー貼り付けをしています。別シート
　　　日付　７／１　
　　　曜日　　木　
１　Ａさん　　１
４　Ｄさん　　１
３　Ｃさん　　２
と貼り付けをしています。
それを関数を使い自動でする方法ありましたら
宜しくお願いします。

回答No.3

imogasi · ベストアンサー

＃２です。＃２では０を見る列だけしか取れません。それで
Function nzero(a, n, o)
Dim cl As Range
m = 0
For Each cl In a
If cl = 0 Then
Else
m = m + 1
If m = n Then
nzero = cl.Offset(0, o)
Exit Function
End If
End If
Next
End Function
に改めます。
Sheet２のA1には
=nzero(Sheet1!$B$1:$B$10,ROW(),-1)といれて下へ複写
B1には
=nzero(Sheet1!$B$1:$B$10,ROW(),0)といれて下へ複写してください。
（テストデータ）
Sheet1のA1:B7
a 1
b 0
c 2
d 0
r 0
f 3
g 1
（結果）
Sheet2のA1:B４に
a 1
c 2
f 3
g 1

お礼

何とかできました。。
ありがとうございました。。

回答No.2

imogasi

結局０の行を省いて、詰めて、別シートにコピー出来れば良いのでしょう。
ＶＢＥの標準モジュールにユーザー関数nzero（名前は何でも、既存の関数名でなければ良い）を定義し
Function nzero(a, n)
Dim cl As Range
m = 0
For Each cl In a
If cl = 0 Then
Else
m = m + 1
If m = n Then
nzero = cl
Exit Function
End If
End If
Next
End Function
を定義し
Ｓｈｅｅｔ２のＡ１に
=nzero(Sheet1!$A$1:$A$10,ROW(A1))
といれ、下方向に式を複写します。
$A$10は最下行を指定してください。
なおＳｈｅｅｔ２の書式を、ユーザー定義の「＃」にして
、下の方に現れる０は空白表示にします。
（例データ）Ｓｈｅｅｔ１のＡ１：Ａ１０に
12
2
0
0
2
3
0
1
0
21
（結果）Ｓｈｅｅｔ２のＡ列
12
2
2
3
1
21

回答No.1

R-G

(1)
　　　日付　７／１
　　　曜日　　木
１　Ａさん　　１
２　Ｂさん　　０
３　Ｃさん　　２
４　Ｄさん　　１・・・
を選択(欲しい範囲をドラッグ)し、右クリックしてコピー→別シートに貼り付けします。
(2)　新しいシートの
１　Ａさん　　１
２　Ｂさん　　０
３　Ｃさん　　２
４　Ｄさん　　１・・・
をドラッグ(選択)して、"データ"の"並べ替え"をクリックします。
(3)"最優先されるキー"に曜日部分である"２列目"を選んで"昇順"にし、"範囲の先頭行"を"データ"にして"OK"します。
(4)曜日の"0(時間)"の部分が不要のようですので、それに隣接するタブを含め、消去します。

という感じでいけそうでしょうか?　説明不足でないと良いのですが；
頑張ってください!!