Excel VBA質問箱 IV

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

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


34047 / 76732 ←次へ | 前へ→

【47900】Re:集計の方法で教えて下さい。
回答  ウッシ  - 07/3/26(月) 10:36 -

引用なし
パスワード
   こんにちは

Sheet1からSheet2として

Sub test()
  Dim v, vv
  Dim i  As Long
  Dim j  As Long
  Dim cntR As Long
  Dim mDic As Object
  Dim s  As String
  Dim c  As Long
  
  With Worksheets("Sheet1")
    v = .Range("A1").CurrentRegion.Value
    cntR = UBound(v, 1)
  End With
  If cntR = 1 Then Exit Sub
  Set mDic = CreateObject("Scripting.Dictionary")
  For i = 2 To cntR
    c = 0: s = ""
    If mDic.Exists(v(i, 2)) Then
      If Val(v(i, 3)) = 2 Then
        If mDic(v(i, 2))(1) <> "2" Then s = "2"
        c = v(i, 4)
      ElseIf mDic(v(i, 2))(1) <> "2" Then
        s = v(i, 3)
      Else
        s = "2"
      End If
      mDic(v(i, 2)) = Array(v(i, 2), s, _
        mDic(v(i, 2))(2) + v(i, 4), mDic(v(i, 2))(3) + c)
    Else
      If Val(v(i, 3)) = 2 Then
        s = "2"
        c = v(i, 4)
      Else
        s = v(i, 3)
      End If
      mDic(v(i, 2)) = Array(v(i, 2), s, v(i, 4), c)
    End If
  Next
  Erase v
  With Worksheets("Sheet2").Range("A1").Resize(mDic.Count + 1, 4)
    .ClearContents
    .Rows(1).Value = Array("伝票NO", "区分", "金額", "区分2金額")
    v = .Value
    i = 2
    For Each vv In mDic.keys
      For j = 0 To 3
        v(i, j + 1) = mDic(vv)(j)
      Next
      i = i + 1
    Next
    .Value = v
  End With
  Set mDic = Nothing: Erase v
End Sub

いまいちのような気がしますけど。

2 hits

【47899】集計の方法で教えて下さい。 質問(煮詰まった) 07/3/26(月) 9:34 質問
【47900】Re:集計の方法で教えて下さい。 ウッシ 07/3/26(月) 10:36 回答
【47901】Re:集計の方法で教えて下さい。 質問(煮詰まった) 07/3/26(月) 12:07 お礼

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