Excel VBA質問箱 IV

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

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


2654 / 13645 ツリー ←次へ | 前へ→

【66682】個数が超えたら割引して計算したい たっくん 10/9/24(金) 23:13 質問[未読]
【66683】Re:個数が超えたら割引して計算したい kanabun 10/9/25(土) 9:22 発言[未読]
【66685】Re:個数が超えたら割引して計算したい Hirofumi 10/9/25(土) 11:59 回答[未読]
【66701】Re:個数が超えたら割引して計算したい たっくん 10/9/27(月) 9:27 お礼[未読]

【66682】個数が超えたら割引して計算したい
質問  たっくん  - 10/9/24(金) 23:13 -

引用なし
パスワード
   例えば、下のようにデータベースがあります。

日付    拠点    個数   金額   小計  割引後小計   累計
9月1日    東京    5    200    1000   1000    1000
9月1日    栃木    4    300    1200   1200    2200
9月1日    埼玉    3    100    300    300    2500
9月2日    茨城    2    200    400    400    2900
9月2日    東京    2    300    600    600    3500
9月3日    栃木    3    500    1500   1500    5000
9月4日    東京    1    100    100    100    5100
9月4日    千葉    5    300    1500   1500    6600
9月4日    群馬    1    500    500    500    7100
9月5日    東京    3    200    600    580    7680
9月5日    埼玉    3    200    600    600    8280
9月6日    神奈川   1    300    300    300    8580
9月6日    東京    2    200    400    360    8940

拠点の「東京」だけ個数が10超えたら金額が10%割引としたい。
「割引後小計」は手で計算して入力したものですが、自動計算できるようにしたいです。
クエリなりVBAなり結構ですので分かる方いましたらご教示ください。

【66683】Re:個数が超えたら割引して計算したい
発言  kanabun  - 10/9/25(土) 9:22 -

引用なし
パスワード
   ▼たっくん さん:
>
>拠点の「東京」だけ個数が10超えたら金額が10%割引としたい。
>「割引後小計」は手で計算して入力したものですが、自動計算できるようにしたいです。

>クエリなりVBAなり結構ですので分かる方いましたらご教示ください。

クエリはわかりませんが、
自動計算ということですから、
割引後小計 列に 以下の数式でどうですか?

=IF(SUMIF($B$2:B2,"東京",$C$2:C2)>10,E2*90%,E2)

【66685】Re:個数が超えたら割引して計算したい
回答  Hirofumi  - 10/9/25(土) 11:59 -

引用なし
パスワード
   こんなのでは?

Option Explicit

Public Sub Sample()

  '個数が10を超えたなら金額が10%割引
  Const clngLimits As Long = 10
  
  Dim i As Long
  Dim j As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim vntData() As Variant
  Dim vntExce() As Variant
  Dim lngExce() As Long
  Dim vntResult() As Variant
  Dim lngTmp As Long
  Dim vntSum As Variant
  Dim strProm As String

  '例外集計をする拠点
  vntExce = Array("東京")
  
  'Listの先頭セル位置を基準とする(先頭列の列見出しのセル位置)
  Set rngList = ActiveSheet.Range("A1")

  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '拠点、個数、金額列データを配列に取得
    vntData = .Offset(1, 1).Resize(lngRows, 3).Value
  End With
  
  '累計数を保存する配列を確保
  ReDim lngExce(UBound(vntExce))
  
  '結果出力用配列を確保
  ReDim vntResult(1 To lngRows, 1 To 3)
  
  'Key列に就いて繰り返し
  For i = 1 To lngRows
    '小計を計算
    vntResult(i, 1) = vntData(i, 2) * vntData(i, 3)
    '例外集計か否かを確認
    For j = 0 To UBound(vntExce)
      If vntData(i, 1) = vntExce(j) Then
        Exit For
      End If
    Next j
    '例外集計で無いなら
    If j > UBound(vntExce) Then
      '小計を割引後小計に
      vntResult(i, 2) = vntResult(i, 1)
    Else
      '累計個数がLimit以内の場合
      If lngExce(j) + vntData(i, 2) <= clngLimits Then
        '割引後小計を計算
        vntResult(i, 2) = vntResult(i, 1)
      Else
        '10個以下の場合、割引無し分の個数を計算
        lngTmp = 0
        If clngLimits > lngExce(j) Then
          lngTmp = clngLimits - lngExce(j)
        End If
        '割引無し分と割引分を計算
        vntResult(i, 2) = lngTmp * vntData(i, 3) _
                + (vntData(i, 2) - lngTmp) * vntData(i, 3) * 0.9
      End If
      '累計個数を更新
      lngExce(j) = lngExce(j) + vntData(i, 2)
    End If
    '累計金額を集計
    vntSum = vntSum + vntResult(i, 2)
    vntResult(i, 3) = vntSum
  Next i
  
  '結果を出力
  With rngList.Offset(1, 4).Resize(lngRows, 3)
    .ClearContents
    .Value = vntResult
  End With
  
  strProm = "処理が完了しました"
   
Wayout:

  Set rngList = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

【66701】Re:個数が超えたら割引して計算したい
お礼  たっくん  - 10/9/27(月) 9:27 -

引用なし
パスワード
   ありがとうございました。

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