1430542389 麻雀ゲームの時間帯別の成績を知りたいので、エクセルから抜き出すマクロをお願いいたします。


シートは2つ。

「詳細成績」と、「着順」シートです。

画像をご確認ください。


詳細成績のJ列にある成績順位1~4(3までしかないときもあります)とQ列の時間。

この時間ごとの成績を調べるため、はじめに何行~何行まで調べるか?

聞いてくる形ではじめ、その間の成績を集計し、着順シートに転記
してほしいのです。転記するのは着順の回数です。何時台に1位は何回あって、2位は何回あって・・
4位は・・・と回数を転記することで分析したいのです。

詳細成績には、時間帯がうまく書かれていない、空白のところもありますが、その部分は無視して集計には入れません。

着順シートには転記するだけで大丈夫です(式は別に入っております)

どうかよろしくお願いいたします。

(関数でできる!とのご質問はご容赦ください。マクロを希望しております)

回答の条件
  • 1人1回まで
  • 13歳以上
  • 登録:2015/05/02 13:53:09
  • 終了:2015/05/03 03:18:41

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4523ベストアンサー獲得回数18802015/05/02 17:40:54

ポイント200pt

こんな感じでどうでしょう。

Sub 着順集計()

    inp = Application.InputBox("詳細成績シートの何行~何行までを集計しますか?")
    a = Split(inp, " ")
    r_start = Val(a(0))
    r_end = Val(a(1))

    Dim tbl(24, 4)
    For r = r_start To r_end
        Set j = Sheets("詳細成績").Cells(r, "J")
        Set h = Sheets("詳細成績").Cells(r, "Q")
        If IsNumeric(h.Value) And Not IsEmpty(h) And h.Value <> "" Then
            tbl(h.Value, j.Value) = tbl(h.Value, j.Value) + 1
        End If
    Next

    For h = 0 To 24
        For j = 1 To 4
            r = 2 + h
            c = j * 2
            Sheets("着順").Cells(r, c) = tbl(h, j)
        Next
    Next

End Sub

着順には 1~4 の数字が入ってるのが前提とか、いろいろ判定を省きまくってますが、自分で作ったシートなら大丈夫ですよね :-)
0時と24時の両方があるのは、質問の画像のままにしています。




追記です。

深夜4などは深夜を除いて4時台で集計していただきたいということです。

了解です。
では、こんな感じで。

Sub 着順集計()

    inp = Application.InputBox("詳細成績シートの何行~何行までを集計しますか?")
    a = Split(inp, " ")
    r_start = Val(a(0))
    r_end = Val(a(1))

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "([1-9]?[0-9])"

    Dim tbl(24, 4)
    For r = r_start To r_end
        Set j = Sheets("詳細成績").Cells(r, "J")
        Set h = Sheets("詳細成績").Cells(r, "Q")
        Set remat = re.Execute(h.Value)
        If remat.Count > 0 Then
            hh = Val(remat(0).SubMatches(0))
            If 0 <= hh And hh <= 24 Then
                tbl(hh, j.Value) = tbl(hh, j.Value) + 1
            End If
        End If
    Next

    For h = 0 To 24
        For j = 1 To 4
            r = 2 + h
            c = j * 2
            Sheets("着順").Cells(r, c) = tbl(h, j)
        Next
    Next

End Sub
他8件のコメントを見る
id:a-kuma3

深夜4などは深夜を除いて4時台で集計していただきたいということです。

了解です。
回答に追記しましたので、確認をお願いします。

2015/05/03 00:28:30
id:oshietekudasai19

ありがとうございました!!しっかりと動きました!本当にありがとうございました!

2015/05/03 03:18:25

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません