【VBA】優先度順に計算を行い指定した値に近づけた

質問

画像のようなシートがあります。

まずBの縦列の合計を2に近づけたいです。
方法としてはB列より右の列から優先度順（1→2→....）にセルを移動し、縦列の合計が2以下ならそのまま、2を上回る場合は移動をしないという方法を検討しています。
これをB列→C列→D列....と繰り返していきたいのですがどのようにやればいいのかわかりません。どなたか教えてください。
セルは優先度順に足していく。
セルを移動する場合、対象の列より右の列のセルから移動させる。

回答No.7

mt2015 · ベストアンサー

ANo.2です。
何度も失礼。
コードを作り直しました。こんな感じでどうでしょう。
セルの色はどのセルがどこに移動したかを解りやすくしたくて付けただけで意味はありません。

Sub Sample()
　　Dim nRow() As Long
　　nPri = 15 '優先度Max
　　nMaxCol = 7 '対象列Max

　　'各優先度の行を確定
　　ReDim nRow(nPri)
　　For i = 1 To nPri
　　　　nNum = Cells(i + 1, 1)
　　　　nRow(nNum) = i + 1
　　Next i

　　'メイン処理
　　For nCol = 2 To nMaxCol
　　　　For i = 1 To nPri
　　　　　　nTotal = WorksheetFunction.Sum(Range(Cells(2, nCol), Cells(nPri + 1, nCol)))
　　　　　　If nTotal > 2 Then Exit For '合計が2を超えるならやめる

　　　　　　'その優先度の右にデータがある場合はそこまでのセルを削除して左方向にシフト
　　　　　　For j = (nCol + 1) To nMaxCol
　　　　　　　　If Cells(nRow(i), j) > 0 Then
　　　　　　　　　　Range(Cells(nRow(i), nCol), Cells(nRow(i), j - 1)).Delete Shift:=xlToLeft
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next j
　　　　Next i
　　　　'合計値を表示
　　　　Cells(nPri + 2, nCol) = "=SUM(R[-" & nPri & "]C:R[-1]C)"
　　 Next nCol
End Sub

お礼

わかりやすく色までつけていただき、ありがとうございます

回答No.6

mt2015

先ほどの回答取り消します。
ちょっと考え直してから再回答します・

回答No.5

mt2015

ANo.2です。
だいぶ解釈が異なっていたようです。
説明が難しい場合、私の場合は処理前と処理後のイメージがあると理解しやすくて助かります。

添付の図のような事がしたいと言う理解で良いですか？
以下のサンプルコードは、データが入っていないセルには何も入っていない（スペースや空白等が無い）と言う前提です。

Sub Sample()
　　Dim nRow() As Long
　　nPri = 15 '優先度Max
　　nMaxCol = 7 '対象列Max

　　'各優先度の行を確定
　　ReDim nRow(nPri)
　　For i = 1 To nPri
　　　　nNum = Cells(i + 1, 1)
　　　　nRow(nNum) = i + 1
　　Next i

　　'メイン処理
　　For nCol = 2 To nMaxCol
　　　　For i = 1 To nPri
　　　　　　nTotal = WorksheetFunction.Sum(Range(Cells(2, nCol), Cells(nPri + 1, nCol)))
　　　　　　If nTotal > 2 Then Exit For '合計が2を超えたらこの列の処理はやめる

　　　　　　'この優先度の右のデータ列番号(データが無い場合は最大列数が返る）
　　　　　　nTargetCol = Cells(nRow(i), nCol).End(xlToRight).Column
　　　　　　If nTargetCol <= nMaxCol Then
　　　　　　　　'データがある場合はそこまでのセルを削除して左方向にシフト
　　　　　　　　Range(Cells(nRow(i), nCol), Cells(nRow(i), nTargetCol - 1)).Delete Shift:=xlToLeft
　　　　　　End If
　　　　Next i
　　　　'合計値を表示
　　　　Cells(nPri + 2, nCol) = nTotal
　　Next nCol
End Sub

回答No.4

imogasi

#1です。
質問は読んでいるよ。
私の案のようにソートすると順序が崩れるし、列的にある列に片寄せすると、それもデータが崩れる（したがって気に食わない人が多い）のは、わかっているよ。
嫌がるだろうと思ったが、復元する方法を加えるのが、夜が遅くて、省略したのだ。私の方法はよい点もあるということを将来わかるはず。
そもそも処理ロジックについて聞いているのだろう。ソート法も１つだということ。他にセルFind法など。
データをそのままにして、優先度に応じてセルデータを探す方法も頭に浮かんだが、処理が初心者には、複雑になると予想したので。
ここは初心者の質問が多い。質問者はそれを越えているのかも。
ーー
それにしても、回答に対し、質問をよく読んでないと責めるような口振りの表現はよくないよ。普通はエクセルで出くわさない、ケースのめづらしい質問だと思っていた。
データ例の表現も、画像じゃなくテストで使えるようにしてよ。
データの特徴も文章に加えたら（例　ある行のデータは１つの列にしか現れない、優先度の数字は連続して振られている？など）

補足

わからないのであればまずは質問をするべきでは？
私の求めているものとは違う回答をわざとされても迷惑なだけですが

回答No.3

mt2015

ごめんなさい、添付する図を間違えました。
正しくはこっちです。

回答No.2

mt2015

説明が解りにくいうえに図も良く見えないので、質問を勘違いしている可能性がありますが……
「セルの移動」とはセル自体を移動させる訳では無く、参照するセルを変えると言う意味で良いですか？
・添付の図の場合、A列の優先度の順に、B12セル→B5セル→B7セルと参照する。
・参照したセルの値を合計していき、合計値が2より大きくなる前で合計をやめてその列の合計欄に合計値を表示。
　＃添付の図のB列の場合、優先度1～7までの合計値1.79を表示
・縦全部を合計しても2以下の場合はその合計値を表示
・合計値を表示したら右隣の列で同じことを行う。

優先度1の値が2より大きかった場合、その列の合計値は0で良いですね？
＃添付の図のF列

質問に添付されている図は見づらいため、優先度が1～15までで横もG列までの例でサンプルを作りました。
この内容で良ければご自身の環境に合わせて修正してください。
質問自体を勘違いしている場合、もう少し見やすく分かりやすい例を提示してみてください。

Sub Sample()
　　For nCol = 2 To 7 'B～G列を対象
　　　　nTotal = 0
　　　　For i = 1 To 15 '優先度は1～15
　　　　　　nData = WorksheetFunction.VLookup(i, Range("A2:G16"), nCol, False)
　　　　　　If (nTotal + nData) > 2 Then Exit For '合計が2を超えるならやめる
　　　　　　nTotal = nTotal + nData
　　　　Next i
　　　　Cells(17, nCol) = nTotal '17行目に各列の合計値を表示
　　Next nCol
End Sub

補足

わかりにくくて申し訳ないです
セルの参照ではなく、セル自体の移動をさせたいと思っております
各行に入る数字は優先度と値ひとつといった感じです。
この添付の画像ですと
2行目は優先度5とC列に0.57のみ
3行目は優先度13とD列に0.54のみといった感じです

計算の順序としては
1.B列の計算
2.B列の値が2以下の場合、優先度1の行の値+B列の合計が2以下かつ優先度1の値が入ったセルがB列以降に存在している場合、優先度1の値をB列に移動
3.B列の計算
4.B列の値が2以下の場合、優先度2の行の値+B列の合計が2以下かつ優先度1の値が入ったセルがB列以降に存在している場合、優先度1の値をB列に移動

これを最後の優先度まで行い、C列へ移動という内容にしたいです。

縦全部を合計しても2以下の場合はその合計値を表示する。
合計値を表示したら右隣の列で同じことを行う。

回答No.1

imogasi

質問のデータ例が画像で、回答者側で、データの打ち直ししないと、回答のテストに使えない。こういうことも考えて質問文を書いて（またデータ例を簡略化して）。
このことを、わかってない質問者がほとんどで、回答した経験がないのだろうが。
夜も遅いので、不完全だが、とりあえず参考に。
ーー
データ例　Ａ２以下
3 ―　－ 12 ＜－Ｄ列
2 ー 23 　　＜－Ｃ列
1 15 　　　　　　　　＜－Ｂ列
5 ー　－　－ 18 　　＜ーＥ列
4 ー　－　－　－　21　　＜－Ｆ列
ーー
Sub test01()
LR = Range("a10000").End(xlUp).Row
’MsgBox LR
For i = 2 To LR
c = Range("xfd" & i).End(xlToLeft).Column
MsgBox c
Cells(i, "B") = Cells(i, c)
If c <> 2 Then
Cells(i, c) = ""
End If
Next i
'-－優先度でソート
Range("a2:B" & LR).Sort Key1:=Range("A1"), Order1:=xlAscending
End Sub
ーー
結果　Ａ２以下
Ａ列　Ｂ列
1 15
2 23
3 12
4 21
5 18
これを上から足していって、目標値を超える行の１つ手前までが目的のデータだと思う。
上記はＶＢＡの初等的な常套手段しか使ってない、簡単なコードがよい点だが。
ただ加えなかった行もＢ列に動いてしまっているが、これがダメなら、対象外の行のデータは、元に戻すなど、処理が相当複雑化しそう。
Ｅｘｃｅｌは、ほしいデータをシート上のセルに、いったん実現しないと、そののちの処理がむつかしいと思う。

補足

質問内容をよく読む癖をつけたほうがよいと思われます。
誰がソートしてほしいといいました？
セルを移動する場合、対象の列より右の列のセルから移動させる。と記載したのですがその辺も理解されていないようですね。