戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
セルに入力されている数値を元に、結合セル範囲のデータを 複製したく思います

    [189573] セルに入力されている数値を元に、結合セル範囲のデータを 複製したく思います-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ ゆりこ -(2019/06/15(15:17))
    □U R L/
      EXCEL2016を利用しています
      
      A1〜D6、E1〜K6、A7〜H15、I7〜K15セルが結合されています。
      I7〜K15セルに、Z3セルの値が表示されています。
      
      N1〜Q6、R1〜X6、N7〜U15、V7〜X15セルが結合されています。
      V7〜X15セルには、Z3セルの値が表示されています。
      
      上記の結合セルは、共に同じデータになります。
      
      Z3セルとAB3セルに入力されている数字をもとにして、
      3行下方部分に上記範囲内のデータを複製し、
      Z3セルとAB3セルに入力されている数字の範囲を順に表示したいです。
      
      例えばZ3セルに4と入れて、AB3セルに6と入れたら、
      
      元々はA1〜D6、E1〜K6、A7〜H15、I7〜K15がセル結合されていて、
      I7〜K15には、4と表示されています。
      
      元々はN1〜Q6、R1〜X6、N7〜U15、V7〜X15がセル結合されていて、
      V7〜X15には、4と表示されています。
      
      Z3セルに4と入力し、AB3セルに6と入力したら、
      
      A18〜D23、E18〜K23、A24〜H32セルを結合します。
      I24〜K32セルを結合させ、5と表示させます。
      
      N18〜Q23、R18〜X23、N24〜U32セルを結合します。
      V24〜X32セルを結合させ、5と表示させます。
      
      A35〜D40、E35〜K40、A41〜H49セルを結合します。
      I41〜K49セルを結合させ、6と表示させます。
      
      N35〜Q40、R35〜X40、N41〜U49セルを結合します。
      V41〜X49セルを結合させ、6と表示させます。
      
      Z3セルに4が入力されていて、ZB3セルに6と入力されているので、
      上記のようになります。
      
      appleさんが回答して下さったコードですが、
      Z3セルに1を入力して、AB3セルに適当な数字を入力すれば問題ないのですが
      
      Z3セルに2を入力して、AB3セルに8と入力すると、数字を表示させる部分が
      
      2345678というように順になればよいのですが、
      
      22345678となってしまいます。
      
      前回質問させて頂きましたのは下記になります
      ht tp://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=189545&rev=0
      
      前回の質問ではL1セルに1と入力したら複製しないとなっていますが、
      
      AB3セルに1と入力したら、データが2以上あればデータを1つだけにしたいです。
      データが1つだけなら、何もしないようにしたいです。
      
      今回の質問で、利用しているコードは下記になります。
      (apple様に回答して下さったコードを一部追加と変更しています。)
      
      Private Sub Worksheet_Change(ByVal Target As Range) ※一部変更しています
       Dim n As Long
       
       If Target.Address = "$AB$3" Then
       n = Val(Target.Value)
       Select Case n
       Case 2 To 500
       MsgBox "セル AB3 に値が入力", vbInformation, "お知らせ"
       Call Test2(n) ' <-- 実行するマクロ指定
       End Select
       End If
      End Sub
      
      Private Sub Test2(n As Long) ※一部追加しています
       Dim i As Long, j As Long
       j = 18
       Application.EnableEvents = False
       Range("A18:X" & Rows.Count).Clear
       
       With Range("A1:X15") 
       For i = 2 To n
       .Copy .Cells(j, 1)
       .Cells(j, 1).Range("I7,V7").Value = i
       j = j + 17
       Next
       End With
       
       Application.EnableEvents = True
       
       Cells.Select
       Selection.RowHeight = 13.5
       
       Range("A1").Select
       
      End Sub
      
      長い文章を最後まで読んでくださってありがとうございます。
      
      宜しくお願い申し上げます。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



      ++++++++++++++++++++
      OS      ⇒OTHER
      Version⇒OTHER
      ++++++++++++++++++++




    [189574] Re[1]: セルに入力されている数値を元に、結合セル範囲のデータを 複製したく思います-

    記事引用/メール受信=OFF■

    □投稿者/ apple -(2019/06/15(15:58))
    □U R L/
      以下、一例です。
      
      Private Sub Worksheet_Change(ByVal Target As Range)
          Dim nB As Long, nE As Long
       
          If Target.Address = "$AB$3" Then
              ' Z3 セルの値を取得 Z3 セルは AB3 セルの二つ左
              nB = Val(Target.Offset(, -2).Value)
              ' AB3 セルの値を取得
              nE = Val(Target.Value)
              ' nB は 1 以上で、nE はそれを超える値の場合
              If 0 < nB And nB < nE Then
                  If nE <= 500 Then ' nE が 500 以下の場合
                      MsgBox "セル AB3 に値が入力", vbInformation, "お知らせ"
                      ' Test3 プロシージャを実行
                      Call Test3(nB, nE) ' <-- 実行するマクロ指定
                  End If
              End If
          End If
      End Sub
      
      Private Sub Test3(nB As Long, nE As Long)
          Dim i As Long, j As Long
          
          j = 18 ' 貼り付け行位置の初期値 18
          Application.EnableEvents = False
          Range("A18:X" & Rows.Count).Clear
          With Range("A1:X15") ' A1:X15 の範囲を
              For i = nB + 1 To nE ' nB の値 +1 〜 nE までループ
                  .Copy .Cells(j, 1) ' j 行 1 列目にコピー
                  ' ' j 行 1 列目を基準とした I7、V7 セルに i の値
                  .Cells(j, 1).Range("I7,V7").Value = i
                  j = j + 17 ' 貼り付け行位置の更新
              Next
              .Parent.Cells.RowHeight = 13.5
              .Cells(1).Select
          End With
          Application.EnableEvents = True
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189594] Re[2]: セルに入力されている数値を元に、結合セル範囲のデータを 複製したく思います-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ ゆりこ -(2019/06/16(21:12))
    □U R L/

      apple様

      遅くなりまして、すみませんでした

      ありがとうございました

      また、宜しくお願い申し上げます




このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G