お世話になります。
EXCEL VBAを使用して自動で行の挿入処理を実施したいと思っております。
やりたい事は添付図の表1を処理ボタンを押せば自動で表2のようにしたいのです。
表2の黄色部分が自動挿入させたい部分です。
例えば「表2作成」というボタンを押したら・・
[sheet1]にある表1をC1からC??の最終行までREADしてC??の文字列が
[定価番販売実績]であれば・・
(1)[定価販売実績]の上の行に[定価販売予定]という行を挿入
(2)[定価販売実績]の下の行に[定価差異]という行を挿入
[得売販売実績]であれば・・
(3)[特売販売実績]の上の行に[特売販売予定]という行を挿入
(4)[特売販売実績]の下の行に[特売差異]という行を挿入
という作業を全商品に対して実施したいのです。
図では3商品ですが実際には変動ですが100~200品位です。
出来上がった新しい表2は別シートに表示できれば最高です!
どなたか方法をご教授いただけませんでしょうか?
よろしくお願い致します。
環境
Windows XP SP3
EXCEL2003
No.2ベストアンサー
- 回答日時:
こんばんは!
VBAでの一例です。
画像通り1行目は項目行で、データは2行目以降にあるとします。
画像を拝見するとA列は結合してあるようですね!
>処理ボタンを押せば自動で・・・
とありますので、操作したいSheetにコマンドボタンを配置するとします。
↓のコードをコピー&ペーストしてコマンドボタンをクリックしてみてください。
コマンドボタンでなくても
メニュー → 挿入 → オートシェイプ → 挿入したオートシェイプ上で右クリック → マクロの登録 → 新規作成
このVBE画面でも構いません
Private Sub CommandButton1_Click() 'この行から
Dim i As Long, k As Long
Range("A:A").UnMerge
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 1) = "" Then
Cells(i, 1) = Cells(i - 1, 1)
End If
Next i
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Cells(i, 3) = "定価販売実績" Then
Rows(i + 1).Insert
Cells(i + 1, 3) = "定価販売差異"
Cells(i + 1, 1) = Cells(i, 1)
Rows(i).Insert
Cells(i, 3) = "定価販売予定"
Cells(i, 1) = Cells(i + 1, 1)
ElseIf Cells(i, 3) = "特売販売実績" Then
Rows(i + 1).Insert
Cells(i + 1, 3) = "特売販売差異"
Cells(i + 1, 1) = Cells(i, 1)
Rows(i).Insert
Cells(i, 3) = "特売販売予定"
Cells(i, 1) = Cells(i + 1, 1)
End If
Next i
Application.DisplayAlerts = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
Range(Cells(i - 1, 1), Cells(i, 1)).Merge
End If
Next i
Application.DisplayAlerts = True
End Sub 'この行まで
※ 1行目と最終行は
コマンドボタンを挿入 → 挿入したコマンドボタン上でダブルクリックすると自動で表示されますので、
ダブらないようにコードをコピー&ペーストしてみてください。
尚、一旦コマンドボタンをクリックすると元に戻せませんので
別Sheetで試してみてくだい。m(_ _)m
この回答への補足
tom04さん、おはようございます!
早速のご連絡ありがとうございました!!
出来ました!!すごいです!
しかし、定価販売差異と特売販売差異が挿入されませんでした。。あとこの2つが挿入されれば完成なのですが・・。
私の環境が悪いのかもしれませんが、再度ご教授いただけあmせんでしょうか?
本当に度々申し訳ございません。
tom04さん、申し訳ございません。
さきほどの補足は私の勘違いで、ちゃんと出来ました!
大変失礼いたしました。
詳細なコードのご提示、本当にありがとうございました!
とても勉強になりました。
No.1
- 回答日時:
その程度のことでしたら関数を使って対応できますね。
シート1のA1セルからC1セルには項目名が有り、お示しのような表が有るとします。
そこでシート2にはA1セルからC1セルにはシート1と同じ項目名を並べたのちにA2セルには次の式を入力し、A2セルからA7セルを選択してセルの結合を行ってから下方にドラッグコピーします。
=IF(ROW(A1)>(COUNTA(Sheet1!$A:$A)-1)*6,"",IF(COUNTIF(A$1:A1,INDEX(Sheet1!$A:$A,ROUNDUP(ROW(A1)/6,0)*2))>0,"",INDEX(Sheet1!$A:$A,ROUNDUP(ROW(A1)/6,0)*2)))
B2セルには次の式を入力して下方にドラッグコピーします。
=IF(ROW(A1)>(COUNTA(Sheet1!$A:$A)-1)*6,"",IF(MOD(ROW(A1)-1,6)+1=2,INDEX(Sheet1!$B:$B,MATCH(OFFSET($A2,-1,0),Sheet1!$A:$A,0)),IF(MOD(ROW(A1)-1,6)+1=5,INDEX(Sheet1!$B:$B,MATCH(OFFSET($A2,-4,0),Sheet1!$A:$A,0)+1),"")))
C2セルには次の式を入力して下方にドラッグコピーします。
=IF(ROW(A1)>(COUNTA(Sheet1!$A:$A)-1)*6,"",CHOOSE(MOD(ROW(A1)-1,6)+1,"定価販売予定","定価販売実績","定価差異","特価販売予定","特価販売実績","特価差異"))
この回答への補足
KURUMITOさん、早速のご連絡ありがとうございます!
出来ました!すごい感動しました!!
しかし、ご教授いただきました下記の数式で、特定の数箇所のSheet1のA??セルの商品名が参照できず、ブランクで表示されてしまっています・・とびとびでブランク表示になるのでsheet1のA??の商品名データに何か原因があるかと思いましたが特に変か所も見当たりません。
ご教授いただきました数式が高度すぎて私の頭では理解できず、どこをどう確認していいのか分かりません。
そこで、下記数式について簡単で結構ですのでご説明いただけませんでしょうか?
なぜ数字の切り上げ時に使うROUNDUPがこの式に必要なのかか理解が出来ないのです・・(泣)。お手数をおかけしまして大変申し訳ありませんが何卒よろしくお願い致します。
=IF(ROW(A1)>(COUNTA(Sheet1!$A:$A)-1)*6,"",IF(COUNTIF(A$1:A1,INDEX(Sheet1!$A:$A,ROUNDUP(ROW(A1)/6,0)*2))>0,"",INDEX(Sheet1!$A:$A,ROUNDUP(ROW(A1)/6,0)*2)))
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 仕事術・業務効率化 エクセル 任意の列(日付)を起点に一定の日数でデータを取り出したい。 4 2022/04/28 12:22
- インターネットビジネス ネットショップでトレーディングカードを売ろうと思っているのですが、初めにショップ開設記念で還元率がす 1 2023/08/17 23:30
- Visual Basic(VBA) VBAで質問があります 1 2022/10/19 10:32
- その他(Microsoft Office) Excelで該当しない項目(#N/Aの商品名)を簡単に表示・抽出させる方法についてです 1 2022/08/25 22:12
- 高校 高校 数学 一次不等式を使った文章問題がわかりません。分かる人教えて下さい! 問題は以下のとおりです 3 2022/06/12 15:09
- その他(お金・保険・資産運用) 至急!【Wolt】各メニューの価格設定の簡単な計算方法 3 2023/03/05 11:58
- その他(データベース) pythonでsqlight勉強中、クエリー結果の利用法教えて下さい 1 2022/04/28 20:38
- メルカリ <メルカリShops>消費者庁による販売許可の出ている機能性表示食品?の調べ方から 1 2022/11/24 17:46
- 簿記検定・漢字検定・秘書検定 簿記2級 未実現利益 基本的な計算が分かりません。。。 Q 1の未実現利益の計算です。親会社は子会社 1 2022/07/13 13:50
- Visual Basic(VBA) VBAで最新のデータを別シートに転記する方法をお教えください。 3 2022/04/07 19:20
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
マイクロソフト 一時使用コード...
-
英数字のみ全角から半角に変換
-
エクセルの貼り付け「リンクさ...
-
大学のレポート A4で1枚レポー...
-
エクセルでXLOOKUP関数...
-
会社PCのメールが更新されない
-
エクセルのシフト表を簡単にGoo...
-
Excelのセルの重複チェックが出...
-
outlookのメールが固まってしま...
-
エクセルでレーダーチャートの...
-
teams設定教えて下さい。 ①ビデ...
-
オフィス365のエクセル
-
Microsoft Edgeの「ニュースと...
-
Microsoft Office Personal 2021
-
Excelで空白以外の値がある列の...
-
Excel テーブル内の空白行の削除
-
マクロ自動コピペ 貼り付ける場...
-
Excel2019と365、2021
-
Outlook 2021 アカウント設定時...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
【スプレッドシート】指定の日...
-
英数字のみ全角から半角に変換
-
会社PCのメールが更新されない
-
マイクロソフト 一時使用コード...
-
Office 2021 Professional Plus...
-
エクセルで例えば、関数を使っ...
-
Microsoft Formsの「個人情報や...
-
1つのPCに「Excel 2010」「Exc...
-
エクセルで例えば、A1に㈱ベ...
-
理由を教えてください。
-
エクセルでXLOOKUP関数...
-
マイクロソフト オフィスについて
-
VLOOKUP関数について
-
teams設定教えて下さい。 ①ビデ...
-
Googleのスプレッドシートでシ...
-
【Excel VBA】PDFを作成して,...
-
Microsoft365で写真をアルバム...
-
Outlook で宛先が複数の場合の人数
-
Excel テーブル内の空白行の削除
おすすめ情報