戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
B列の数に合わせてA列の値を複製

    [189375] B列の数に合わせてA列の値を複製-

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

    □投稿者/ みのる -(2019/05/22(22:27))
    □U R L/

      初めて書き込みさせていただきます。
      皆さんのお力をいただければ幸いです。

      【Before】 →   【After】  
      A列 B列      A列  B列
      111 a       111 a
      222 b 111 b
      333 c 111 c
      444 d 111 d
      555 222 a
      666 222 b
      222 c
      222 d
                (A列の値の分だけ続く)

      と、このようにA列をB列の値だけ複製して行く形にしたいと思っています。
      A列の値と数、またB列の値と数は毎回異なります。
      なので、値を固定値として指定することができないため、できればinputなどを利用して、
      数値を入力してから実行できるようにしたいと思っています。

      Webを2日間色々調べ、なんとか4回ほどマクロを回すことで実行できるようにはなりましたが、できれば一度の実行でinputから複製・コピーなどを全て実行できると嬉しいです。

      よろしくお願いいたします。


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




    [189376] Re[1]: B列の数に合わせてA列の値を複製-

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

    □投稿者/ マナ -(2019/05/22(23:07))
    □U R L/

      >Webを2日間色々調べ、なんとか4回ほどマクロを回すことで実行できるようにはなりました

      そのコードをたたき台にして改良できるかもしれません。
      提示できませんか。







    [189378] Re[2]: B列の数に合わせてA列の値を複製-

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

    □投稿者/ みのる -(2019/05/23(11:21))
    □U R L/
      マナさん
      
      ありがとうございます。
      以下がコードになります。
      マクロは3回でした。
      
      こちらを都度のデータ内容に合わせて修正して、一つ一つ実行しております。
      この方法ですと、私しか使用できないため、誰でも使用できるように自動化できればと考えております。
      
      よろしくお願いいたします。
      
      ---------------------------
      Sub 行追加()
          Dim i As Long
          Dim r As Long
          Const 追加行数 As Long = 4 '固定値
          r = Range("A" & Rows.Count).End(xlUp).Row
      Application.ScreenUpdating = False
      挿入行数 = 5  '追加したいユーザー数(ユーザーIDから-1)で記載
      行 = 3 '行を最初に入れる行のため固定でOK
      Do While Cells(行, 1).Value <> ""
         Cells(行, 1).EntireRow.Resize(挿入行数).Insert Shift:=xlDown
         行 = 行 + 挿入行数 + 1
      Loop
      Application.ScreenUpdating = True
       
      End Sub
       
       
      Sub ユーザーコピー()
      Dim i As Long, x As Integer
      Application.ScreenUpdating = False
      Range("b2:b7").Copy  'コピーしたいユーザーIDの幅に合わせて数値を変更
      For i = 1 To 4 '登録した配送先の数-1の数で4を変更
      Cells(x + 8, 2).PasteSpecial  '店舗コードが入った2番目のセルに合わせて8を変更
      x = x + 6  'コピーするユーザーIDの数に6を変更
      Next
      With Application
      .CutCopyMode = False
      .ScreenUpdating = True
      End With
       
      End Sub
       
       
      Sub 配送先コピー()
      Dim i As Integer
      Dim S As String
      S = ""
      For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
      If Cells(i, 1).Value = "" Then
      Cells(i, 1).Value = S
      Else
      S = Cells(i, 1).Value
      End If
      Next i
       
      End Sub


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

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



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




    [189381] Re[3]: B列の数に合わせてA列の値を複製-

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

    □投稿者/ マナ -(2019/05/23(19:55))
    □U R L/
      修正を最小限にしたつもりですので
      理解できるでしょうか。
      
      
      Sub test()
          Dim rngID As Range
          Dim rng配送先 As Range
           Dim ID数 As Long
          Dim i As Long, x As Long
      
          'ユーザーIDコピー
          
          Set rngID = Range("b2", Range("b2").End(xlDown))
          Set rng配送先 = Range("A2", Range("A2").End(xlDown))
          
          ID数 = rngID.Count   'コピーするユーザーIDの数
          
          rngID.Copy
          For i = 1 To rng配送先.Count - 1
              x = x + ID数
              rngID.Offset(x).PasteSpecial
          Next
          
          Application.CutCopyMode = False
      
          '行追加
          
          Dim 挿入行数 As Long
          DimAs Long
          
          挿入行数 = ID数 - 1
      
          行 = 3 '行を最初に入れる行のため固定でOK
          Do While Cells(行, 1).Value <> ""
             Cells(行, 1).Resize(挿入行数).Insert Shift:=xlDown
             行 = 行 + 挿入行数 + 1
          Loop
      
          '配送先コピー
          
          Dim S As String
          
          For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
              If Cells(i, 1).Value = "" Then
                  Cells(i, 1).Value = S
              Else
                  S = Cells(i, 1).Value
              End If
          Next i
           
      End Sub


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

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




    [189383] Re[4]: B列の数に合わせてA列の値を複製-

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

    □投稿者/ みのる -(2019/05/23(22:21))
    □U R L/

      マナさん

      ありがとうございます!!
      書いていただいたもので問題なく理想通りの操作ができました。

      正直、お恥ずかしながら、先に記載したコードはWebで探したコードをコピーし、
      カスタマイズしたものですので、コードの意味を理解していた訳ではないです。

      しかし、VBAをもっと勉強しなければと思うことができました。
      ありがとうございます。



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

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

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


- Child Forum -
Edit:ゆう-G