色彩検定1級を取得する魅力を紹介♪

先日、マクロで行を自動挿入する投稿をさせていただき
まして無事解決した案件の続きになるのですが・・・><

【行いたいポイント】
①Sheet1の表からSheet2へ行の挿入を自動で行う。
(規格数×カラー数の自動挿入)
→自動挿入は前回解決させていただきました。
ご回答いただきました方々本当にありがとうございました。

②【今回のメイン】今回はマクロで可能であれば皆さまのお力を再度お借りしたい部分です。
下記の現在の状況で自動で添付画像の様に規格数とカラー数が表にまとめられる様な形にしたいと
考えておりますが、関数で処理しようと検討はしているのですが行が増えると関数もずれてしまい
ただやみくもに時間だけが過ぎてしまっている状況です><


【現在の状況】
・Sheet1 の表には規格数が最大10規格内で増加元減するため最小規格と最大規格のみを入力しています。
・現在は規格数に番号を振り最大値から最小値を引いて挿入する行数を求めている状況です。
・カラー数は最大で6カラーまであり表に全て記載できる様にしています。
・先日、カラー挿入数を自動で入れるマクロを投稿にて教えて頂き行は自動で増やせる状況です。
→添付画像にするために元表の変更が必要であれば変更をします。

他力本願的で本当に申し訳ございませんが、頭が限界で投稿させていただきました。

「マクロに精通されている皆様。教えて頂けま」の質問画像

質問者からの補足コメント

  • へこむわー

    【追記補足】
    1画像を修正をさせていただきました。
    2規格に関しては、最大10個まで増加減するので表の見やすさの都合上【規格①】に最小規格値と【規格②】に最大規格値 のみ の現状は表です。(マクロを設定する上で必要で規格を⑩まで増やします。)

    「マクロに精通されている皆様。教えて頂けま」の補足画像1
      補足日時:2021/06/26 14:23
  • つらい・・・

    【概要】
    規格は商品毎に最大10種類あり商品別に選びます。
    表の商品(ポテト)は全10種類ある規格の中から①80g②120gの規格2種類を使用しています。(画像に載せていない別表に入力)
    各規格のカラーは上限6種類で都度カラー作成し別表入力しています。 【Sheet1】は別表集計をコピペしたものです。現在は手入力で行を増やして【Sheet2】の様に修正しています。【80g×各カラー】【120g×各カラー】
    【Sheet2】はイメージ図で実際は同シート内を編集したいと考えています。
    【規格×カラー挿入数】は手作業用に規格数とカラー数の個数カウントし行を増やす指標です(フォントは無視してください><
    【目的】
    Sheet1にコピペされた表をそのままマクロをいれて Sheet2(イメージ図)のような
    規格×カラーが表になるようSheet1を修正したいと考えています。

      補足日時:2021/06/26 18:10
  • シートが2枚あります。
    ①【オプションdeta1】サイズ:カラーのみ画像 ②【オプション登録】集計する画像です。
    ①→②に先日の内容をUPするのが目的理想です。
    シートの行タイトル(フォント)について
    ・赤フォント今回のご相談箇所です。
    ・黒・青全てコピー対象です。
    (青フォントは関数の計算式で結果を表示している意味でフォントを変えています。)
    この内容で伝わりますでしょうか?ご面倒をおかけしてばかりで本当に申し訳ございませんが
    宜しくお願いいたします。

    「マクロに精通されている皆様。教えて頂けま」の補足画像3
      補足日時:2021/07/04 01:05
  • 【オプション登録】画像です。

    「マクロに精通されている皆様。教えて頂けま」の補足画像4
      補足日時:2021/07/04 01:06
  • HAPPY

    補足画像:CB列メイン画像

    「マクロに精通されている皆様。教えて頂けま」の補足画像5
      補足日時:2021/07/08 22:18
gooドクター

A 回答 (12件中1~10件)

C列も設定するようにしました。

前回のは破棄してください。

Option Explicit
Public Sub 表作成()
Dim dicT As Object
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim maxrow1 As Long
Dim maxrow3 As Long
Dim row1 As Long
Dim row2 As Long
Dim row3 As Long
Dim key As Variant
Dim size_rg As Range
Dim color_rg As Range
Dim rg1 As Range
Dim rg2 As Range
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh1 = Worksheets("オプションdeta1")
Set sh2 = Worksheets("オプション登録")
Set sh3 = Worksheets("レディースファッション")
maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row 'sheet1の最大行取得
maxrow3 = sh3.Cells(Rows.Count, "H").End(xlUp).Row 'sheet3の最大行取得

For row3 = 2 To maxrow3
key = sh3.Cells(row3, "H").Value
dicT(key) = sh3.Cells(row3, "CB").Value
Next

sh2.Rows("2:" & Rows.Count).ClearContents 'Sheet2の2行目以降をクリア
row2 = 2
For row1 = 2 To maxrow1
Set size_rg = Range(sh1.Cells(row1, "B"), sh1.Cells(row1, "U"))
Set color_rg = Range(sh1.Cells(row1, "V"), sh1.Cells(row1, "AA"))
For Each rg1 In size_rg
If rg1 <> "" Then
For Each rg2 In color_rg
If rg2 <> "" Then
sh2.Cells(row2, "A").Value = sh1.Cells(row1, "A").Value 'アイテムコード
key = sh1.Cells(row1, "A").Value
If dicT.exists(key) = True Then
sh2.Cells(row2, "C").Value = dicT(key)
End If
sh2.Cells(row2, "D").Value = "カラー"
sh2.Cells(row2, "E").Value = rg2 'カラー
sh2.Cells(row2, "F").Value = 0
sh2.Cells(row2, "K").Value = rg1 'サイズ
sh2.Cells(row2, "U").Value = 0
row2 = row2 + 1
End If
Next
End If
Next
Next
MsgBox ("完了")
End Sub
    • good
    • 1
この回答へのお礼

本当にありがとうございます。
何から何までご親切に対応いただき心から感謝しています!
本当にありがとうございました!理想の表がすぐにできました!

お礼日時:2021/07/10 23:18

レディースファッションの画像拝見しました。


オプションdeta1のA列のアイテムコードと同じものが、
レディースファッションのJ列にあると考えて良いですか。
(それともJ列ではなくI列ですか。画像ではどちらになるか判別できませんでした)
    • good
    • 1
この回答へのお礼

お忙しい中、ご連絡ありがとうございます。
お気遣いいただきありがとうございます。画像には無いのですがH列に
なります。
いろいろと本当にありがとうございます。宜しくお願い申し上げます。

お礼日時:2021/07/09 23:24

No9です。


オプション登録のC列へ名前をマクロで自動的に設定することは、可能だと思いますが、
その場合は、レディースファッション」 の正確なレイアウトが必要なります。
(特にCB列)
もし、マクロで自動的に設定したい場合は、その旨返信ください。又、その場合は
レディースファッション」 の正確なレイアウトを画像で提示してください。
    • good
    • 1
この回答へのお礼

凄い・・・凄すぎます!><

一瞬で綺麗に理想の表が出来ました。涙涙涙涙
本当にありがとうございます!何から何まで全ておんぶに抱っこで
さすがに・・・これ以上はと思いながら・・・・。

画像を添付させていただきます・・><
マクロで自動設定やっぱりしたいです!
本当にすいません!お願いします!
画像添付する上で必要な補足事項などは自分でまったく想像がつかない
のでお手数ですが必要な補足事項がございましたらご連絡頂ければ幸いです。

お礼日時:2021/07/08 22:15

No8です。


以下のマクロを標準モジュールに登録してください。
C列は常に空白になります。

Option Explicit
Public Sub 表作成()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow1 As Long
Dim row1 As Long
Dim row2 As Long
Dim size_rg As Range
Dim color_rg As Range
Dim rg1 As Range
Dim rg2 As Range
Set sh1 = Worksheets("オプションdeta1")
Set sh2 = Worksheets("オプション登録")
maxrow1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'sheet1の最大行取得
sh2.Rows("2:" & Rows.Count).ClearContents 'Sheet2の2行目以降をクリア

row2 = 2
For row1 = 2 To maxrow1
Set size_rg = Range(sh1.Cells(row1, "B"), sh1.Cells(row1, "U"))
Set color_rg = Range(sh1.Cells(row1, "V"), sh1.Cells(row1, "AA"))
For Each rg1 In size_rg
If rg1 <> "" Then
For Each rg2 In color_rg
If rg2 <> "" Then
sh2.Cells(row2, "A").Value = sh1.Cells(row1, "A").Value 'アイテムコード
sh2.Cells(row2, "D").Value = "カラー"
sh2.Cells(row2, "E").Value = rg2 'カラー
sh2.Cells(row2, "F").Value = 0
sh2.Cells(row2, "K").Value = rg1 'サイズ
sh2.Cells(row2, "U").Value = 0
row2 = row2 + 1
End If
Next
End If
Next
Next
MsgBox ("完了")
End Sub
    • good
    • 1

No7です。


オプションdeta1とオプション登録の画像参照しました。

今までの話の流れでは、
マクロを実行すると、オプションdeta1のデータをもとにして、オプション登録の2行目以降を
全て自動で設定するという前提で考えていました。

その前提で、再度質問します。前提自体が間違っている場合は、その旨返信ください。
①オプション登録のC列のデータはどこから持って来ればよいですか。
②オプション登録のD列のデータは「カラー」固定で良いですか。
③オプション登録のE列のデータは、オプションdeta1のV列~AA列のデータを持って来れば良いですか。
④オプション登録のF列のデータは、「0」固定で良いですか。
⑤オプション登録のJ列のデータは、「サイズ」固定で良いですか。
⑥オプション登録のK列のデータは、オプションdeta1のB列~U列のデータを持って来れば良いですか。
⑦オプション登録のF列のデータは、「0」固定で良いですか。
⑧オプション登録のB,F,H,I,L,M,N,O,P,Q,R,S,T,V列は常に空白で良いですか。
    • good
    • 1
この回答へのお礼

①オプション登録のC列のデータはどこから持って来ればよいですか。
→現在は【sheet「 レディースファッション」 のCB列2~1000までから(=で繋げています。】作業上不都合であればこちらで値コピペで対応します。

②オプション登録のD列のデータは「カラー」固定で良いですか。
→固定です。

③オプション登録のE列のデータは、オプションdeta1のV列~AA列のデータを持って来れば良いですか。
→仰る通りです。

④オプション登録のF列のデータは、「0」固定で良いですか。
→「0」でお願いします。

⑤オプション登録のJ列のデータは、「サイズ」固定で良いですか。
→「サイズ」でお願いします。

⑥オプション登録のK列のデータは、オプションdeta1のB列~U列のデータを持って来れば良いですか。
→仰る通りです。
⑦オプション登録のF列のデータは、「0」固定で良いですか。
→「0」でお願いします。
⑧オプション登録のB,F,H,I,L,M,N,O,P,Q,R,S,T,V列は常に空白で良いですか。
→空白で問題ありません。

こちらから適格な補足事項を本来するべきだったと反省しております。
大変お手数お掛けして申し訳ございませんでした。ありがとうございます。
大変恐縮ですが何卒よろしくお願い申し上げます。

お礼日時:2021/07/07 22:01

No3です。


>ただ、2度手間3度手間を掛けてしまう事の無いよう2点確認でお伝えさせ
>て頂きたいと考えておりますが宜しいでしょうか?
>①https://gyazo.com/46e057caaa46b8fc1cadc0091721117c
>で頂いた表の様に作成しておりますがその列の前後には他の資料(値など)もかなり繋がっています。(他の資料(値など)は行の挿入に伴いコピペされればいい資料です。)
>そのご確認は必要でしょうか?必要であれば出来る限りお伝えさせて頂きます。
>②結果として、今回の行の挿入に伴いhttps://gyazo.com/1c5e2ef882cdbafd4fa12eb2432332dcの様な表がマクロで一瞬で完成する事がメインですが
>①でお伝えさせて頂いた他の付随する資料(値など)も平行してマクロで自動でコピペされると本当に嬉しいのが本音です。

私が提示したレイアウトの他にもコピー対象となる列が有るのでしたらその正確なレイアウトを
https://gyazo.com/46e057caaa46b8fc1cadc0091721117c
のような形で提示していただけませんでしょうか。
また、
コピー先の正確なレイアウトも
https://gyazo.com/1c5e2ef882cdbafd4fa12eb2432332dc
のような形で提示していただけませんでしょうか。

尚、このgooのサイトで大きな画像をアップすると画像が不鮮明になるので、
その場合は、gyazo.comへアップしていただけるとありがたいです。
    • good
    • 1
この回答へのお礼

親切丁寧にご連絡ありがとうございます。
画像をUPしましたのでご確認を頂けると幸いです。
本当におんぶに抱っこで申し訳ございません><が宜しくお願いいたします。

お礼日時:2021/07/04 01:11

できるだけ、質問主さんの思考に合わせて、ふたつのプロシジャを書いてみました(内容は、ほぼ同じですが・・・)。



下記の「規格」プロシジャを実行すると、行を増やして「規格①」の列に規格のパターンを設定します。
「カラー」プロシジャは「カラー①」の列にカラーのパターンを設定します。
上記を実行した上で、不要な列(規格②、カラー②~⑥」)を削除すれば、ご希望の結果になると思います(不要な列の削除は、ご自分で考えてみて下さい)。

Sub 規格()
Dim i As Long
Dim Re As Long
Re = 2
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
Rows(i).Copy
Rows(i + 1).Resize(Re).Insert Shift:=xlDown
Rows(i).Columns("D:E").Copy
Rows(i + 1).Columns("D").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True
Rows(i).Delete
Next i
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Sub カラー()
Dim i As Long
Dim Re As Long
Re = 6
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
Rows(i).Copy
Rows(i + 1).Resize(Re).Insert Shift:=xlDown
Rows(i).Columns("F:K").Copy
Rows(i + 1).Columns("F").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Transpose:=True
Rows(i).Delete
Next i
Columns("F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
    • good
    • 1
この回答へのお礼

行の挿入からアドバイスを頂くためのサポートまでいただき心から感謝しています。本当にありがございました。今回は新規の表を挿入する流れでご提供いただく方にお願いしてみようと思います。
ここまで、解決の糸口を頂きまして心から感謝しています。
ありがとうございました。

お礼日時:2021/07/01 00:09

こんばんは



『記入されている「規格」と「カラー」の組み合わせを全てリストアップしたい』
というのが本来の目的であるのなら、No3様もご指摘なさっているように、H列のデータは不要ですね。
というか、あっても無駄と言えます。
(結果的な組み合せ数だけあっても、何ら役には立ちませんので)

処理としては、いちいち「行の挿入」を行うよりも、新しいシートに順に作成してしまった方がはるかに簡単だし、処理も速いと思います。
(行数にもよりますが、速度はたいした差が出ないとは思いますけれど…)

どうしても、元のシートを書き直したいのであれば、新規作成後に全体をそっくり上書きして、作成シートは削除するようにマクロを組めばよいでしょう。
    • good
    • 2
この回答へのお礼

親切にわかりやすい補足の説明と方向性のアドバイス本当にありがとうございます。
マクロや表作成の基本があまりわかっていない私には本当に助かりました。
アドバイスをもとに頑張ってみます!

お礼日時:2021/07/01 00:06

#2です


なぜ緑から始まるのか、~なら緑 みたいなロジックを示せないのであれば
Sheet2にポテトが2行すでにある場合などの時の処理が出来ないと思います。
もし、そのようなケースや規格やカラーが増減するのなら、
#2のコードのようにデータを書き直す方が容易と考えます。
ちなみに#2のコードはA~Hまでで、途中に空白が無い事が条件になりますが ループ数でなく範囲を変えコレクションでループ(空白を飛ばす)すれば、作れると思います。

行の挿入でどうしても行いたい場合は、先に挙げた場合や色と規格の関連性、順番などを定義する事が必要です。

値が~の時、~する、違う時は~する と、、、

限定的なコードで惑わせるのは良くないかも知れませんが、
ご質問の画像にある 配置の場合、チョコ、クッキーに値を入れて
ステップ実行で下記を試してください。

処理の動きが判れば、範囲や条件を加えて出来るかも知れませんが、
提供される方が訪れているようなので、問題を解決するためにお任せするのも良いかも知れません。

Sub sample1()
Dim i As Long, j As Long, n As Long
Dim Rng As Range, r As Range, Ary
Set Rng = Worksheets("Sheet1").Range("B3", Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp))
With Worksheets("Sheet2")
For Each r In Rng
If r.Value <> "" Then
On Error Resume Next
n = .Range("B:B").Find(r.Value).Row
.Range(n + 1 & ":" & n + r.Offset(, 7).Value).Insert
For i = 1 To Application.CountIf(r.Offset(, 2).Resize(, 2), "<>")
For j = 1 To Application.CountIf(r.Offset(, 4).Resize(, 3), "<>")
If .Cells(n, 1).Offset(, 4).Value <> r.Offset(, 3 + j).Value Then
n = n + 1
.Cells(n, 1).Resize(, 3).Value = r.Offset(, -1).Resize(, 3).Value
.Cells(n, 1).Offset(, 3).Value = r.Offset(, 1 + i).Value
.Cells(n, 1).Offset(, 4).Value = r.Offset(, 3 + j).Value
End If
Next
Next
End If
Next
End With
End Sub
    • good
    • 2
この回答へのお礼

お忙しい中、ご親切ご丁寧に本当にありがとうございました。
安易に行の挿入と表作成だけを考えていましたが、仰る通り条件設定など
が必要になる事への無知さなを実感しました><
今回は現在の表なども一度見直しながら新規シートの作成で頑張ってみます。

本当に感謝しています。ありがとうございました!

お礼日時:2021/07/01 00:01

補足された【概要】を読みました。


商品の規格数が10種類、カラー数が6種類あるなら、Sheet1は、下記のようなレイアウトになりますか。
Sheet1の画像(下記URL参照)(このサイトは画像が不鮮明なのでこちらにアップしました)
https://gyazo.com/46e057caaa46b8fc1cadc0091721117c

もし、上記の通りであれば、「規格×カラー挿入数」の列を作らなくても、マクロで自動的に
下記のようなSheet2を作成することは可能です。
Sheet2(下記URL参照)
https://gyazo.com/1c5e2ef882cdbafd4fa12eb2432332dc
Sheet1の1行目の見出しは予め、手入力しておく必要がありますが、2行目以降は全てマクロで
設定可能です。

上記で良ければマクロの提供は可能です。
    • good
    • 1
この回答へのお礼

お忙しい中、本当にありがとうございます。
親切丁寧にこちらの背景を考慮いただきURL内表作成ありがとうございます。
大変恐縮ですが、マクロの設定ご提供をお願いさせていただきたいです。

行いたい事と、URL画像がかなり現状と近い形で驚きました。

ただ、2度手間3度手間を掛けてしまう事の無いよう2点確認でお伝えさせて頂きたいと考えておりますが宜しいでしょうか?

https://gyazo.com/46e057caaa46b8fc1cadc0091721117c
で頂いた表の様に作成しておりますがその列の前後には他の資料(値など)もかなり繋がっています。(他の資料(値など)は行の挿入に伴いコピペされればいい資料です。)そのご確認は必要でしょうか?必要であれば出来る限りお伝えさせて頂きます。

②結果として、今回の行の挿入に伴いhttps://gyazo.com/1c5e2ef882cdbafd4fa12eb2432332dcの様な表がマクロで一瞬で完成する事がメインですが
①でお伝えさせて頂いた他の付随する資料(値など)も平行してマクロで自動でコピペされると本当に嬉しいのが本音です。

①②の現状と希望なのですが、それに伴い表の新規挿入や先表の準備が必要であれば新しく用意します。

お忙しい中、本当に申し訳ございませんがご連絡よろしくお願いします。

お礼日時:2021/06/30 23:55

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング