Excelで、フィルタ表示（マクロ使用）の結果を別シートにコピーした後・・・

質問

｜日付｜開催地｜英｜米｜仏｜伊｜独
｜○日｜神奈川｜壱｜壱｜●｜□｜壱
｜◎日｜神奈川｜●｜壱｜壱｜□｜□
｜△日｜神奈川｜壱｜壱｜壱｜□｜●
｜▲日｜和歌山｜壱｜壱｜壱｜壱｜●

このようなデータベース（表）があります。
１行目がタイトルで英～独はチーム名です。
チーム名欄には点数が入力されています。

　※漢数字は普通の数字、”□”は空白に読み替えてください

ここで検索用シートにて、例えば開催地を
神奈川で検索すると

｜日付｜開催地｜英｜米｜仏｜伊｜独
｜○日｜神奈川｜壱｜壱｜●｜□｜壱
｜◎日｜神奈川｜●｜壱｜壱｜□｜□
｜△日｜神奈川｜壱｜壱｜壱｜□｜●

現在はこんな感じで検索結果が表示されます。

このとき検索結果と共に各チームの点数の合計を
検索結果が表示された最終行の次の行に計算させて
表示したいのですが、全ての点数を加算するのではなく
そのチームについている直近の●より
下の点数のみを合計して表示したいのです。

｜日付｜開催地｜英｜米｜仏｜伊｜独
｜○日｜神奈川｜壱｜壱｜●｜□｜壱
｜◎日｜神奈川｜●｜壱｜壱｜□｜□
｜△日｜神奈川｜壱｜壱｜壱｜□｜●
□□□□□□□□壱□参□弐□□□零　←こんな風に

英は、◎日において●が付いているので合計点は１点。
伊は、神奈川においては得点がないので空白とする。
独は、抽出された最終日において●なので点数は０点となる。

更にこの状態から得点のないチームを除きたい。
ただし、伊は除外するが、独は０点では
あるものの点数はあると考えて残す。

｜日付｜開催地｜英｜米｜仏｜独
｜○日｜神奈川｜壱｜壱｜●｜壱
｜◎日｜神奈川｜●｜壱｜壱｜□
｜△日｜神奈川｜壱｜壱｜壱｜●
□□□□□□□□壱□参□弐□零

↑最終的にこのような形で表示したいのですが
どのように処理すればよいでしょうか。

回答No.2

papayuka · ベストアンサー

#1です。

何処で止まるのか、どんなメッセージで止まるのかを書けばある程度は推測出来ますが、、、
VBAヘルプがインストール済みならば、解らない部分にカーソルを入れて F1キーを押すとヘルプが表示されます。
VBAヘルプが未インストールなら OfficeのCDから追加インストールします。

例）　Offset　が解らないなら、Offsetという単語の中にカーソルを入れて F1キーを押下

またVBE画面とExcel画面を並べて表示し、VBEメニューのデバック－ステップ実行にして F8キーを押下していくと実行する様子や変数の状況などを確認出来ます。（私が提示したサンプルは殆ど動きがないですが、、、）

Sub Test()
'変数宣言
Dim myCol As Integer, myVal
Dim LRow As Long, myRow As Long

'アクティブシートに対して
With ActiveSheet
　'A列の最終行+1の行番号を保持（合計を入れる行とする）
　LRow = .Cells(65536, 1).End(xlUp).Offset(1, 0).Row
　'タイトル行（1行目）の最終列を探し、最終列から3列目までループ
　'右から左に処理をするのは列を削除する可能性があるため
　For myCol = .Range("IV1").End(xlToLeft).Column To 3 Step -1
　　　'変数初期化
　　　myVal = 0
　　　'対象列の最終行番号を取得
　　　myRow = .Cells(65536, myCol).End(xlUp).Row
　　　'対象列の最終行番号が1ならばタイトルのみと判断し列を削除
　　　If myRow = 1 Then
　　　　.Columns(myCol).Delete
　　　Else
　　　　'対象列の最終行番号が1じゃない場合
　　　　'最終行から上にループ（変数myRowが1より大か、●じゃないなら）
　　　　Do While myRow > 1 And .Cells(myRow, myCol).Value <> "●"
　　　　　 'セルの値を足す
　　　　　 myVal = myVal + .Cells(myRow, myCol).Value
　　　　　 '変数を減らす（上にループするため）
　　　　　 myRow = myRow - 1
　　　　Loop
　　　　'ループを抜けたら結果を合計行に代入
　　　　.Cells(LRow, myCol) = myVal
　　　End If
　'次の列へ
　Next myCol
End With
End Sub

お礼

papayukaさん

今回は本当にご迷惑をおかけし、また大変な失礼が
あった事を深くお詫び申し上げます。

急いでいたものでこの様なマナー違反をしてしまい
深く反省しております。

今後この様な事がないよう気を付けます。

この度は本当に失礼しました。
返答頂き本当にありがとうございました。

回答No.3

papayuka

ありゃ？
http://okwave.jp/kotaeru.php3?q=2261678

これって失礼な行為ですよ。
少なくともここは「閉じてから」立てるべきだと思いませんか？
#2を書いて馬鹿を見た。

他の質問も閉じない方のようですが。

お礼

本当に失礼致しました。

他の質問についても早急に対処致します。

どうか気を悪くなさらないでください。
本当に助かりました。

どうもありがとうございました。

回答No.1

papayuka

A1から始まるタイトル付きのリストで A1=日付、B1=開催地、C列以降にチームがあると想定してます。
ベタですが、、、

Sub Test()
Dim myCol As Integer, myVal
Dim LRow As Long, myRow As Long
With ActiveSheet
　LRow = .Cells(65536, 1).End(xlUp).Offset(1, 0).Row
　For myCol = .Range("IV1").End(xlToLeft).Column To 3 Step -1
　　　myVal = 0
　　　myRow = .Cells(65536, myCol).End(xlUp).Row
　　　If myRow = 1 Then
　　　　.Columns(myCol).Delete
　　　Else
　　　　Do While myRow > 1 And .Cells(myRow, myCol).Value <> "●"
　　　　　 myVal = myVal + .Cells(myRow, myCol).Value
　　　　　 myRow = myRow - 1
　　　　Loop
　　　　.Cells(LRow, myCol) = myVal
　　　End If
　Next myCol
End With
End Sub

お礼

大変ありがとうございます。

papayukaさんには以前にもお世話になりました。
あまりにも素早く的確な回答で助けられております。

簡単なシートを作って試してみたところ
思っていた通りの結果になりびっくりしました。
自分ではもっと複雑な作業をしなければならないと
思っていました。（というかまだまだVBAについて
知らない事が多いです）

早速、適用しようと今作っている本シートの方に
組み込んでみたのですが、うまくいかず止まって
しまいました。

できれば上に記述頂いたコードの各行に
VBAの簡単な訳を付けて頂けないでしょうか。

お手数おかけしますがよろしくお願い致します。