Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11全般 : Excel 2019)
貼り付けと値の移動と行の削除処理について
投稿日時: 24/02/25 11:07:17
投稿者: まめちゃん

お世話になります。
 
質問をさせてください。
以下の処理を実行しようと思っています。
 
shees2に
B2からB5まで1〜4
C2からC5まで5〜8
D2からD5まで9〜12の値が入っており、
これをsheet1のB2:D5に貼り付けます。
 
貼り付けた値のB列とC列の右隣に列を追加して
C2に2を、E2に6を、G2に10を貼り付け、3行目を削除する。
C3に4を、E3に8を、G3に12を貼り付け、4行目を削除する。
 
結果、
B2〜G2に1〜10
B3〜G3に3〜12と表示させる。
 
マクロの記録を使えば簡単に処理できると思いますが、
自分なりにDo LOOP処理などのVBAを身に着けたく
ネットや似たような処理が記載されている書籍を真似てみましたが、
初心者の力不足・知識不足故、うまくいきません。
 
教えてほしいという厚かましさも重々承知しております。
ヒントなり今後の学習の参考としたく、大変恐縮ではありますが、
質問させていただきました。
どうかお力添えの程、よろしくお願いいたします。

回答
投稿日時: 24/02/25 12:31:58
投稿者: WinArrow

絶対番地で記述されているが、マクロ化する意味はあるのですか?
VBAコードをあれやこれや悩んでいるよりも、手操作の方が早いと思いますが・・・・

回答
投稿日時: 24/02/25 12:59:22
投稿者: WinArrow

ループの勉強あ目的ですか?
 
行の追加/削除は、下から上に向かって操作します。
列の追加/削除は、右から左に向かって操作します。
これは鉄則です。
 
マクロの記録では、ループ処理はコードは作成できません。
 
マクロの記録で作成したコードを、
行番号や列番号を変数に修正して、
Do と Until (Or Whole)の間に入れ込みます。

回答
投稿日時: 24/02/25 13:35:26
投稿者: simple

既にコメントいただいていますので、問題の整理と、お願いだけしたいと思います。
 
実行したいことは、Sheet2に下記のような表があったときに、
それを並び替えて、Sheet1のような表にしたいということですか?
 

<<Sheet2>>元の表
      B列  C    D
2行    1   5    9
3      2   6   10
4      3   7   11
5      4   8   12

<<Sheet1>>作成したい表
      B列  C   D   E    F    G
2行    1   2   5   6    9   10
3行    3   4   7   8   11   12

> 貼り付けた値のB列とC列の右隣に列を追加して
> C2に2を、E2に6を、G2に10を貼り付け、3行目を削除する。
> C3に4を、E3に8を、G3に12を貼り付け、4行目を削除する。

これは、あなたが手作業でやるならこうやるという案ですね。
別にこれどうりにしなくても、上記が満たされれば、どんな案でもいい訳ですね。
 
引用:
自分なりにDo LOOP処理などのVBAを身に着けたく
ネットや似たような処理が記載されている書籍を真似てみましたが、
初心者の力不足・知識不足故、うまくいきません。
ということであれば、途中でも結構なので、あなたのトライ結果を示してください。
学習目的であればそれがベストかと思います。それでは頑張ってください。

回答
投稿日時: 24/02/25 20:08:11
投稿者: WinArrow

参考コードを紹介します。一寸、ハードルが高いかな?
アルゴリズムは、至極簡単です。
作業用に複写表(複写元セルと複写先セルの対応表)を作成します。
そうすることで、汎用化が図れる。
当然、メンテナンス性も向上する。
 
 
◆準備:複写表を作成します。
例:Sheet2のJ2〜K13、
J列:Sheet2のセルアドレス、K列:Sheet1のセルアドレス
J列 K列
B2 B2
B3 C2
B4 B3
B5 C3
C2 D2
C3 E2
C4 D3
C5 E3
D2 F2
D3 G2
D4 F3
D5 G3
  

Sub 複写処理()
Dim COPYTBL, x As Long
'複写表読込→配列に格納
    COPYTBL = Worksheets("Sheet2").Range("J2:K13").Value
'配列をループして、セルを複写
    For x = LBound(COPYTBL) To UBound(COPYTBL)
        Worksheets("Sheet1").Range(COPYTBL(x, 2)).Value = Worksheets("Sheet2").Range(COPYTBL(x, 1)).Value
'または、セルの書式を含む
'    Worksheets("Sheet2").Range(COPYTBL(x, 1)).Copy_
'        Destination:=Worksheets("Sheet1").Range(COPYTBL(x, 2))
    Next
End Sub

回答
投稿日時: 24/02/25 23:28:38
投稿者: simple

回答コメントを待っていましたが、参考コードを提供します。
読み解いてみてください。不明点があれば質問して下さい。

Sub test()
    Const 段数  As Long = 2         '一列のデータを何段に収めるか
                                    '■必要に応じて変更
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng   As Range
    Dim r     As Range
    Dim mat   As Variant
    Dim numRows&, numColumns&, colmn2&  ' &はLongの型宣言文字
    Dim j&, k&                          ' As Longと書くのと同じです。

    Set ws1 = Worksheets("Sheet2")
    Set ws2 = Worksheets("Sheet1")

    Set rng = ws1.[B2].CurrentRegion
    numRows = rng.Rows.Count            'number of Rows
    numColumns = rng.Columns.Count      'number of Columns
    colmn2 = Application.Ceiling(numRows / 段数, 1)
                                        '書き込み先の何個の列に展開されるか
    ws2.[B2].CurrentRegion.ClearContents '書き込み先をいったん初期化
    'データの転記
    For j = 1 To numColumns
        mat = rng.Columns(j).Value          '元データのj列目のデータ
        Set r = ws2.[B2].Offset(0, colmn2 * (j - 1)).Resize(段数, colmn2)
                                            'それに対する書き込み先のセル範囲
        For k = 1 To numRows
            r.Cells(k) = mat(k, 1)   'このCellsの使い方はややトリッキーかも。
        Next
    Next
End Sub

投稿日時: 24/02/26 10:49:22
投稿者: まめちゃん

参考コード提供ありがとうございます。
じっくり読んでみます。
 
疑問点も出てくると思いますので、
その時は質問させて下さい。
 
※処理にあたり参考にしていたHPです。
https://bomcler.net/?p=355

回答
投稿日時: 24/02/26 17:50:36
投稿者: WinArrow

投稿日時: 24/02/25 20:08:11
のレスで紹介した、「複写表」も数式で作成可能です。
  
要は、列挿入や行削除のような手作業レベルをVBA記述するのは、
汎用性を損ないます(他に応用することが難しい)
複写元と複写先セルドレスの対応のアルゴリズム(法則)を見つけて
数式やVBAに組み込むというスタンスで考えるとよいでしょう。
数式を読みといてVBAを作成してみてください。
  
Sheet2のセルアドレスから、Sheet1のセルアドレスを数式で求めます。
  
説明
A列:Sheet2のセルアドレス(B2〜D2,B3〜D3,B4〜D4,B5〜D5)
B列:A列値から列番号を数字で求める数式
C列:B列値からSheet1の列番号を数字で求める数式
D列:C列値&A列値からSheet1のセルアドレスを求める数式
  
数式
セルA2:B2
セルB2:=(B2-1)*2
セルC2:=ADDRESS(INT(RIGHT(A2,1)/2)+1,C2,4,1)
セルD2:=ADDRESS(INT(RIGHT(A2,1)/2)+1,C2,4,1)
  
B2〜D2を選択して、下へフィルドラッグします。

投稿日時: 24/02/29 10:58:59
投稿者: まめちゃん

頂いた処理コードを参考にして
作成してみます。
 
皆様のご尽力ありがとうございました。