Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


24205 / 76732 ←次へ | 前へ→

【57878】Re:データ集計の方法
回答  Hirofumi  - 08/9/18(木) 20:08 -

引用なし
パスワード
   こんな手順で出来ると思います

1、Sheets("data")を、「NAME」昇順、「BUDHO」昇順、「CODE」昇順、「TYPE」昇順で整列
2、DataListの先頭行を取り出す
3、DataListの2行目を取り出す
4、1行目と2行目の「NAME,BUDHO,CODE,TYPE」を其々比較する
5、もし、1項目でも違うなら、1行目をSheets("data編集")へ出力
6、3行目を取り出し、2行目と3行目の比較を行う
7、項目全てが同じなら、2行目の「TIME」に3行目の「TIME」を加算
8、4行目を取り出し、2行目と比較、1項目でも違うなら、2行目をSheets("data編集")へ出力
9、此れを最終行の下まで行う(最終行の下の行をダミーデータとして使う)

Option Explicit
Option Compare Text

Public Sub Sample()

  '◆DataListのデータ列数(A列〜F列)
  Const clngColumns As Long = 6
  
  Dim i As Long
  Dim j As Long
  Dim lngRow As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim rngResult As Range
  Dim vntResult As Variant
  Dim vntData As Variant
  Dim strProm As String

  '◆DataListの先頭セル位置を基準とする(A列の列見出しのセル位置)
  Set rngList = Worksheets("data").Cells(1, "A")

  '◆出力Listの先頭セル位置を基準とする(A列の列見出しのセル位置)
  Set rngResult = Worksheets("data編集").Cells(1, "A")

  '画面更新を停止
'  Application.ScreenUpdating = False
  
  '"data編集"に就いて
  With rngResult
    '行数の取得(行末位置取得)
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    '結果を消去
    If lngRows >= 1 Then
      .Offset(1).Resize(lngRows, clngColumns).ClearContents
    End If
  End With
  
  '"data"に就いて
  With rngList
    '行数の取得(行末位置取得)
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    'データを「TYPE」昇順で整列
    .Offset(1).Resize(lngRows, clngColumns).Sort _
        Key1:=.Offset(1, 4), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlStroke
    'データを「NAME」昇順、「BUDHO」昇順、「CODE」昇順で整列
    .Offset(1).Resize(lngRows, clngColumns).Sort _
        Key1:=.Offset(1, 1), Order1:=xlAscending, _
        Key2:=.Offset(1, 2), Order2:=xlAscending, _
        Key3:=.Offset(1, 3), Order3:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        SortMethod:=xlStroke
  End With
  
  '先頭行を配列に取得
  vntResult = rngList.Offset(1).Resize(, clngColumns).Value
  '2行目以降最終行+1まで繰り返し
  For i = 2 To lngRows + 1
    '1行分データを取得
    vntData = rngList.Offset(i).Resize(, clngColumns).Value
    '前の行と「NAME,BUDHO,CODE,TYPE」を比較
    For j = 2 To 5
      '内容が違うならForを抜ける
      If vntResult(1, j) <> vntData(1, j) Then
        Exit For
      End If
    Next j
    '内容が違う場合
    If j <= 5 Then
      '集計用配列(前の行データ)を"data編集"に出力
      lngRow = lngRow + 1
      rngResult.Offset(lngRow).Resize(, clngColumns).Value = vntResult
      '集計用配列に現在データを代入
      vntResult = vntData
    Else
      '集計用配列の「TIME」の列に現在行の「TIME」の列を加算
      vntResult(1, 6) = vntResult(1, 6) + vntData(1, 6)
    End If
  Next i
  
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  Set rngResult = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

0 hits

【57874】データ集計の方法 MIRURU 08/9/18(木) 16:06 質問
【57876】Re:データ集計の方法 kanabun 08/9/18(木) 16:52 発言
【57878】Re:データ集計の方法 Hirofumi 08/9/18(木) 20:08 回答
【57880】Re:データ集計の方法 kanabun 08/9/18(木) 21:47 発言
【57881】Re:データ集計の方法 kanabun 08/9/18(木) 21:59 発言
【57937】Re:データ集計の方法 MIRURU 08/9/22(月) 11:30 お礼

24205 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free