質問です。

下記データをB列の種別ごとに集計できる関数またはマクロをお願いします。
 答え
 B列      G列          H列  I列   J列
AAAAAA   0000-00-00 00:00:00   0  0
AAAAAA   2011/4/27 19:12:00    0  0   DoCoMo
AAAAAA   0000-00-00 00:00:00   1  1
AAAAAA   0000-00-00 00:00:00   0  0   KDDI
AAAAAA   2011/4/30 19:12:00    0  0
AAAAAA       2           5  4    2  
BBBBBB   2011/4/29 19:12:00    0  1    DoCoMo
BBBBBB   0000-00-00 00:00:00   1  0
BBBBBB   0000-00-00 00:00:00   0  1    KDDI
BBBBBB   2011/4/28 19:12:00    0  0
BBBBBB       2           4  2    2


B列のコードの最後に同じコード名を1行足して表示し
その行に各列の集計をする。
G列は0以外の日付の入った件数
H列は全件数
I列は0の件数
J列は表示文字の件数

よろしくお願いします。

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2011/05/04 12:38:14
  • 終了:2011/05/04 14:25:47

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692011/05/04 13:51:41

ポイント60pt

B列は同じ値が連続するとして作成しています。

連続していない場合はB列でソートすればいいです。

また、G列の日付以外の文字列は"0000-00-00 00:00:00"としています。

過去の質問の"0000/00/00 00:00:00"を使っている場合はコード中のその部分を変更してください。

先頭行は1行目からにしていますが、2行目からの場合は10行目の

stRow = 1

stRow = 2

にしてください。


Sub Macro()
    Dim i As Long
    Dim lastRow As Long
    Dim stRow As Long
    Dim myG As Long
    Dim myH As Long
    Dim myI As Long
    Dim myJ As Long
    Dim c As Long
    
    stRow = 1
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    
    For i = stRow To lastRow
        If Cells(i + c, "G").Text <> "0000-00-00 00:00:00" And Cells(i + c, "G").Value > 0 Then
            myG = myG + 1
        End If
    
        myH = myH + 1
        
        If Cells(i + c, "I").Value = 0 Then
            myI = myI + 1
        End If
        
        If Cells(i + c, "J").Value <> "" Then
            myJ = myJ + 1
        End If
        
        If Cells(i + c, "B").Value <> Cells(i + c + 1, "B").Value Then
            Rows(i + c + 1).Insert
            c = c + 1
            Cells(i + c, "B").Value = Cells(i + c - 1, "B").Value
            Cells(i + c, "G").NumberFormatLocal = "G/標準"
            Cells(i + c, "G").Value = myG
            Cells(i + c, "H").Value = myH
            Cells(i + c, "I").Value = myI
            Cells(i + c, "J").Value = myJ
            myG = 0
            myH = 0
            myI = 0
            myJ = 0
        End If
    Next i
    
End Sub
id:inosisi4141

早速ありがとうございます。

上手くゆきました。

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

2011/05/04 14:25:30
  • id:Silvanus
    先越されちゃいましたねw
    http://rct3jp.info/hatena/hatena_inosisi4141_110504.xls
    -----
    Option Explicit

    Sub Hatena_inosisi4141_110504()

    ' ※注意※
    ' データの途中に空白行が存在するケースは想定していません。
    ' 現バージョンでは、空白のコード列を検出した行で処理が停止する様になっています。

    Const lngRowTop As Long = 1 ' 処理を開始する行の番号
    ' 見出し行がある場合は、実際にデータが
    ' 格納されている最初の行の番号を指定して下さい。

    ' 列番号
    Const strCCode As String = "B" ' コード
    Const strCDate As String = "G" ' 日付
    Const strCNum1 As String = "H" ' 数字1
    Const strCNum2 As String = "I" ' 数字2
    Const strCCarr As String = "J" ' 携帯電話キャリア

    Dim lngRowCount As Long ' 行カウンタ
    Dim lngRowStart As Long ' 同一のコードが入力されている最初の行を格納
    Dim lngCCIsDate As Long ' 有効な日付が入力されているセルのカウンタ

    lngCCIsDate = 0
    lngRowCount = lngRowTop
    lngRowStart = lngRowCount

    Do
    Do
    lngCCIsDate = lngCCIsDate - IsDate(Cells(lngRowCount, strCDate)) ' 有効な日付が入力されていたらカウンタ+1
    lngRowCount = lngRowCount + 1
    Loop Until Cells(lngRowCount, strCCode).Value <> Cells(lngRowCount - 1, strCCode).Value ' 同じコードが続いているならループ
    Rows(lngRowCount).Insert Shift:=xlShiftDown ' 1行挿入
    Cells(lngRowCount, strCCode).Value = Cells(lngRowCount - 1, strCCode).Value ' 挿入行にコード記入
    Cells(lngRowCount, strCDate).Value = lngCCIsDate ' 挿入行に有効な日付が入力されたセル数を記入
    Cells(lngRowCount, strCDate).NumberFormatLocal = "G/標準" ' & そのセルの書式を「標準」に設定(日付形式になるのを防ぐ)
    ' (下3行) 数字1/2、キャリアのカウント
    Cells(lngRowCount, strCNum1).Value = Application.Count(Range(Cells(lngRowStart, strCNum1), Cells(lngRowCount - 1, strCNum1)))
    Cells(lngRowCount, strCNum2).Value = Application.CountIf(Range(Cells(lngRowStart, strCNum2), Cells(lngRowCount - 1, strCNum2)), 0)
    Cells(lngRowCount, strCCarr).Value = Application.CountA(Range(Cells(lngRowStart, strCCarr), Cells(lngRowCount - 1, strCCarr)))
    lngRowCount = lngRowCount + 1
    lngRowStart = lngRowCount ' 同一コードが入力されている最初の行をリセット
    lngCCIsDate = 0 ' 有効な日付が入力されているセルのカウンタをリセット
    Loop Until Application.CountA(Cells(lngRowCount, strCCode)) = 0

    End Sub

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

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

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

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