Excel VBA質問箱 IV

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

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


4716 / 76735 ←次へ | 前へ→

【77635】Re:【Excel】経理の表について
発言  β  - 15/11/13(金) 19:46 -

引用なし
パスワード
   ▼かお さん:

今後はルールを守っていただくとして。

レイアウト、不明なところもありますが、
A列が案件、B列が開始日、C列が終了日、D列から右に月(データとしては日付型。表示形式で m月になっている)
1行目がタイトル行、2行目からデータということにしています。
按分計算の結果でてきた計算誤差については最終月で調整しています。

Sub Test()
  Dim c As Range
  Dim dic As Object
  Dim v As Variant
  Dim n As Long
  Dim x As Long
  Dim d As Date
  Dim f As Long
  Dim t As Long
  Dim days As Long
  Dim tot As Long
  Dim amt As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  With Range("A1").CurrentRegion
    ReDim v(1 To .Rows.Count - 1, 1 To .Columns.Count - 4)
    For Each c In .Rows(1).Offset(, 4).Resize(, .Columns.Count - 4).Cells
      dic(Format(c.Value, "yyyymm")) = dic.Count + 1
    Next
    For Each c In .Columns(1).Offset(1).Resize(.Rows.Count - 1).Cells
     tot = 0
      days = DateDiff("d", c.Offset(, 1).Value, c.Offset(, 2).Value) + 1
      n = DateDiff("m", c.Offset(, 1).Value, c.Offset(, 2).Value) + 1
      d = c.Offset(, 1).Value
      For x = 1 To n
        If n = 1 Then
          f = Day(c.Offset(, 1).Value)
          t = Day(c.Offset(, 2).Value)
        Else
          If x = 1 Then
            f = Day(c.Offset(, 1).Value)
            t = Day(DateSerial(Year(c.Offset(, 1).Value), Month(c.Offset(, 1).Value) + 1, 0))
          ElseIf x = n Then
            f = 1
            t = Day(c.Offset(, 2).Value)
          Else
            f = 1
            t = Day(DateSerial(Year(d), Month(d) + 1, 0))
          End If
        End If
        
        amt = c.Offset(, 3).Value * (t - f + 1) / days
        If x = n Then amt = c.Offset(, 3).Value - tot
        tot = tot + amt
        If dic.exists(Format(d, "yyyymm")) Then
          v(c.Row - 1, dic(Format(d, "yyyymm"))) = amt
        End If
        
        d = DateAdd("m", 1, d)

      Next
    Next
  End With
  
  Range("E2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
  
End Sub
0 hits

【77633】【Excel】経理の表について かお 15/11/13(金) 17:30 質問[未読]
【77634】Re:【Excel】経理の表について β 15/11/13(金) 18:17 発言[未読]
【77635】Re:【Excel】経理の表について β 15/11/13(金) 19:46 発言[未読]

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