No.2ベストアンサー
- 回答日時:
こんばんは!
画像が小さくて詳細が確認できないのですが・・・
おそらくこういうコトであろうという憶測です。
↓の画像でB列数値の合計が108になるごとに区切りたい!という解釈です。
前提条件としてデータは2行目以降にあり、A列は商品ごとに並んでいるとします。
商品に関係なく、B列数値のみ上から合計して、
「108」になるようにまとめて「108」を超えたものは、
行を挿入し、「108」を超えた数値を差し引いて表示としています。
(最終行は108に満たないこともあります)
シートモジュールですので、
画面左下の操作したいSheet見出し上で右クリック → コードの表示 → VBE画面に↓のコードをコピー&ペースト
→ Excel画面に戻りマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)
Sub Sample1() 'この行から
Dim i As Long, k As Long, lastRow As Long, myVal
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
k = Int(WorksheetFunction.Sum(Range("B:B")) / 108) * 2
For i = 2 To lastRow + k
myVal = myVal + Cells(i, "B")
If myVal >= 108 Then
If myVal = 108 Then
Rows(i + 1).Insert
Cells(i + 1, "B") = 108
myVal = 0
i = i + 1
Else
Rows(i + 1 & ":" & i + 2).Insert
With Cells(i + 1, "B")
.Value = 108
.Offset(1) = myVal - 108
.Offset(1, -1) = Cells(i, "A")
.Offset(-1) = .Offset(-1) - .Offset(1)
End With
myVal = 0
i = i + 1
End If
End If
Next i
End Sub 'この行まで
※ 一旦マクロを実行すると元に戻せませんので、
別Sheetでマクロを試してみてください。m(_ _)m
この回答へのお礼
お礼日時:2014/03/17 14:26
本当にありがとうございました!
古い?バージョンのため、他の方が
お教えいただいたものが、うまく機能せず
こちらの方を使用させていただきました。
お忙しい中、ありがとうございました!
No.3
- 回答日時:
質問者様の画像では、左の小さい表のデータが何列の何行目以下に並べられているのかという事や、左の小さい表が何というシート名のシート上にあるのかという事、右の大きい表が何というシート名のシート上のどの様なセル範囲に出力すれば良いのかという事、等々、不明な点が多々御座いますので、前提条件として、元データである左の小さい表の中で、「ABC-181」といったコード番号(?)はA列に、「55」等の数値はB列に入力されているものとします。
又、左の小さい表そのものを作り変えてしまうのでは、元データが失われてしまう事になりますから、左の小さい表はそのまま残る様にしておき、、右の大きい表を別のシート上のA列~B列に新たに作表するものとします。
又、左の小さい表において、実際に数値が入力されているのは何行目からであるのかという事に関しては、マクロの方で自動的に検出し、B列に数値が入力されていない行範囲は、「商品」とか「数量」といった項目名が入力されている欄と見做して、新たに作成される右の大きい表の上側の所に、そのままコピーされる様にものとします。
その場合、まず、元データである左の小さい表が存在しているシートを開いている状態とした上で、下記のマクロを使ってみて下さい。(書式もコピーされる様になっております)
Sub Macro()
Static pieces As Long
Dim q0 As Double
Dim sn1, sn2, s1, s2, s3, pn As String
Dim q, r0, r1, r2, rt, p1, p2, p3 As Long
Dim d As Boolean
Dim f As Variant
sn1 = ActiveSheet.Name
sn2 = sn1 & "箱詰"
If Application.WorksheetFunction. _
Count(Columns("B:B")) = 0 Then GoTo Label9
s1 = ""
s2 = "1箱あたりの入数は以下の個数で宜しいですか?"
s3 = Chr(10) & Chr(10) _
& " ※入数を0とするか、或いは[キャンセル]ボタンを押しますと" _
& Chr(10) & Chr(10) & "処理を中断してマクロを終了します"
If pieces < 0 Then pieces = 0
Label1:
If pieces = 0 Then s2 = "1箱あたりの入数を入力して下さい"
q0 = Application.InputBox(Title:="入数の入力", _
Prompt:=s1 & s2 & s3, Default:=pieces, Type:=1)
s1 = ""
If q0 = 0 Then GoTo Label8
If q0 < 0 Or Int(q0) < q0 Then
pieces = 0
s1 = "入数として設定できるのは正の整数値だけです"
Else
pieces = q0
End If
If pieces = 0 Then GoTo Label1
rt = 0
Do
rt = rt + 1
Loop Until Range("B" & rt) <> "" And IsNumeric(Range("B" & rt))
If Evaluate("NOT(ISREF('" & sn2 & "'!A1))") Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = sn2
End If
Sheets(sn2).Select
Columns("A:B").Clear
Sheets(sn1).Range("A1:B" & rt).Copy
With Range("A1")
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteColumnWidths
End With
With Range("A" & rt & ":B" & rt)
.Borders(xlEdgeTop).LineStyle = .Borders(xlEdgeBottom).LineStyle
.Borders(xlEdgeTop).Color = .Borders(xlEdgeBottom).Color
.Borders(xlEdgeTop).TintAndShade = .Borders(xlEdgeBottom).TintAndShade
.Borders(xlEdgeTop).Weight = .Borders(xlEdgeBottom).Weight
End With
r1 = rt - 1: r2 = r1: p1 = 0: p2 = 0: d = False
GoSub Label2
Application.CutCopyMode = False
Range("A" & rt & ":B" & rt).Copy
Do
r2 = r2 + 1
If p2 < 1 Then GoSub Label2
If p1 >= pieces Then GoSub Label3
If p1 + p2 < pieces Then
p3 = p2
Else
p3 = pieces - p1
End If
p1 = p1 + p3
p2 = p2 - p3
If d = False Then
With Range("A" & r2)
.Value = pn
.Offset(0, 1).Value = p3
.PasteSpecial Paste:=xlPasteFormats
End With
End If
Loop Until d
GoSub Label3
Application.CutCopyMode = False
Sheets(sn1).Range("A" & 1 & ":B" & rt - 1).Copy
Range("A1").PasteSpecial Paste:=xlPasteFormats
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
GoTo Label0
Label2:
With Sheets(sn1)
Do
r1 = r1 + 1
d = Application.WorksheetFunction. _
Count(.Range("B" & r1 & ":B" & Columns.Rows.Count)) = 0
Loop Until d Or (.Range("B" & r1) > 0 And IsNumeric(.Range("B" & r1)))
If d Then
pn = "": p2 = 0
Else
pn = .Range("A" & r1).Value
p2 = .Range("B" & r1).Value
End If
End With
Return
Label3:
With Range("A" & r2)
.Value = ""
.Offset(0, 1).Value = p1
.PasteSpecial Paste:=xlPasteFormats
End With
p1 = 0: r2 = r2 + 1
Return
Label8:
s1 = "入数が設定されていません。" & Chr(10)
q = MsgBox("処理の実行を中止してマクロを終了します。" _
& vbLf & "宜しいですか?" _
& vbLf & vbLf & " [はい]:終了" _
& vbLf & " [いいえ]:入数の指定のやり直し" _
, vbYesNo + vbDefaultButton2, "処理中止")
If q = vbNo Then GoTo Label1
GoTo Label0
Label9:
q = MsgBox("元データには数量が入力されていません。" _
& vbLf & " 処理の実行を中止してマクロを終了します。" _
, vbOKOnly, "データ無し")
Label0:
End Sub
No.1
- 回答日時:
こんばんは
VBAでプログラムを組む必要がありますね。
行を挿入する間隔が一定であれば(例えば3行おき)、全体のデータ行数を(例えば)3で割った回数だけループを回して、都度行を挿入していけばできそうですね。
以下は例です。
行の挿入は
Range("2:2").Insert
データ行数が少なければループを回さずに
Range("3:3,4:4,5:5,6:6").Insert Shift:=xlDown
と一気に挿入してしまってもいいです。
括弧内の文字列は、それぞれプログラムで作ります。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excel 区切り位置指定ウィザードの選択データプレビューで全列を指定する方法 お世話になります。E 1 2023/01/17 16:36
- Excel(エクセル) 【至急 詳しい方教えて下さい】Excelの表を変換したい 6 2022/04/21 18:35
- Excel(エクセル) エクセルでキーリストからデータを取り出して1枚1枚印刷するには? 11 2022/06/27 09:52
- Excel(エクセル) エクセル バーコード作成で他のシートを参照するには? 2 2023/05/03 16:57
- その他(プログラミング・Web制作) プログラミング pythonの問題について 2 2022/04/19 00:41
- Excel(エクセル) Excel、同じフォルダ内のExcelファイルの特定シートのみを1つのファイルに集約したい 8 2022/09/07 15:12
- Excel(エクセル) IF 関数で「〇〇 という文字を含む場合」の分岐処理で表示された数字はSUMで数字集計できますか? 3 2022/08/02 16:29
- Excel(エクセル) EXCEL マクロで 同じフォルダ内の複数ファイルの複数行全体を選択して1つのファイルに集約 4 2022/09/27 18:41
- Visual Basic(VBA) エクセルマクロでアニメを作る方法を教えてください。 1 2023/02/07 14:27
- 統計学 統計分析とExcelに詳しい方、何卒よろしくお願いいたします。 6 2022/05/27 10:30
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
オートフィルタのリストを順番...
-
ピボットテーブル→参照が正しく...
-
WEB上の表の列コピー選択方法は?
-
エクセルで作成した縦に長い表...
-
【エクセル】行挿入で数式もい...
-
一つのシートの中に複数のペー...
-
Excelピボットテーブルで 総計...
-
エクセルVBAで、行コピーを複数...
-
エクセルのリストから欠番を拾...
-
エクセル シートのコピーをリ...
-
Excelの数式のコピーで列移動で...
-
メモ帳からエクセルに貼り付け...
-
エクセルで各ページに同じ文書...
-
エクセルVBAでメモリ解放するに...
-
エクセルの列幅
-
一太郎にエクセルの表を貼り付...
-
文字列+数字から最大を抽出す...
-
Excelのセルの中の見えないデー...
-
Excel 表から値をさがして隣の...
-
Excelのコピー&ペーストについて
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
一つのシートの中に複数のペー...
-
WEB上の表の列コピー選択方法は?
-
オートフィルタのリストを順番...
-
【エクセル】行挿入で数式もい...
-
エクセルで作成した縦に長い表...
-
Excelの数式のコピーで列移動で...
-
ピボットテーブル→参照が正しく...
-
Excelピボットテーブルで 総計...
-
エクセルVBAで、行コピーを複数...
-
メモ帳からエクセルに貼り付け...
-
Excel 表から値をさがして隣の...
-
エクセルのリストから欠番を拾...
-
エクセルの列幅
-
エクセルの関数の使い方 繰越...
-
エクセルに詳しい方、助けてく...
-
PDFからExcelに変換する時に「...
-
一太郎にエクセルの表を貼り付...
-
Excelで検索結果をテキストボッ...
-
エクセル シートのコピーをリ...
-
VBA csvを100万行ずつ各...
おすすめ情報