Excel (VBA)

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

 
(Windows 10 Home : Excel 2013)
リストに行を追加する方法
投稿日時: 20/03/12 16:41:22
投稿者: やさは

別のサイトで質問させていただき途中まではできたのですが、仕様変更があり詰まってしまいましたので助けていただけると嬉しいです。
 
 __A___BC_____D___F〜G__H〜AA__AB〜AG___
 1
・ 都度入力部分の項目等

13
14_____項目__No.__****__****____****
15___________ 1___結合__結合____結合
16___________ 2___結合__結合____結合
17___________ 3___結合__結合____結合
18___________ 4___結合__結合____結合
19___________ 5___結合__結合____結合
 
上記のような入力フォームがあります。
 
A4〜A19→結合
B15〜C19→結合
D列を起点として行を増やし入力フォームを増やしたいです。
ただしAの結合セル部分の範囲までが一セットとなりその下に1行開けて同じフォーマットのセットが追加されていく仕様の為、マクロの一番下から最後を検索するといったものが使えません。
 
別のサイトで下記のマクロを教えていただき、単品の時には問題がなかったのですが
追加で上記の条件が付いてしまったため、四苦八苦しています。
 
Sub 行の挿入()
        With Cells(Rows.Count, "D").End(xlUp)
            .EntireRow.Copy
            .EntireRow.Insert Shift:=xlDown
            .Resize(, 30).ClearContents
            .Value = WorksheetFunction.Max(.EntireColumn) + 1
        End With
    End Sub
 
 
無理やりではありますが、
行追加したいセットのA列結合部を選択した状態で
 
Sub 位置()
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Offset(-1, 3).Select
End Sub
 
を使えば上記図のD19に飛べることはわかったのですが、
その後、教えていただいたマクロの様に
行の挿入やNoの変更ができず困っております。
 
何卒よろしくお願いいたします。

回答
投稿日時: 20/03/12 19:30:01
投稿者: mattuwan44

あれ?ここマルチポスト禁止ではないんですね。。。。。
 
まぁ、いいけど、もこなさんもこっちも見てるかもですよ?
僕もあっちを見てたけど静観してました。
 
結合セルがあるとすごい難しくて、いい案が出なかったですけど、
毎度毎度、セルの結合解除&結合を繰り返した方が簡単かも?
処理速度は遅くなるかもだけど。。。。
 
>単品の時には問題がなかったのですが
>追加で上記の条件が付いてしまったため、四苦八苦しています。

項目のセル(B列)クリックでマクロ起動に変えてみてはいかがでしょう?
 
一部のセルをダブルクリックしたときだけマクロを実行する
https://www.relief.jp/docs/013874.html
 
試してたマクロ消しちゃったなぁ。。。

回答
投稿日時: 20/03/12 20:28:13
投稿者: WinArrow
投稿者のウェブサイトに移動

発想をかえてみては?
 
表を作成する場合
ワープロ的発想は、罫線を先に作成してから、セルにデータを入力します。
 
表計算的発想は、データ入慮kしてから、後で見やすいように罫線を引きます。
この時、セルの結合する。
 
この発想に基づけば、最後にセルを結合すればよいので、
行の挿入する場合でも、隣のセルが結合されているか気にすることはありません。

回答
投稿日時: 20/03/12 21:15:22
投稿者: simple

どこかに同時進行の質問を立てているんですか?
そこでの議論と同じ議論を回答者に求めているんでしょうか?
無駄になりませんか?
無駄になっても私は別にかまいません、ということなんでしょうか。
 
ここの質問掲示板は、マルチポストを明示的に禁止はしていませんが、
仮にマルチポストするのであっても、
どこそこ(urlを示す)に今、同じ質問をしています、
とか書くのが普通じゃないですか?
それでなければ、余りに自分勝手じゃないですか?
 
ところで、
・結合セルにするための基準はなんですか?
・そして、挿入したときには、結合セルとの関係ではどういうルールになっているんですか?
・既存の結合データのなかの最終行に追加するケースもあれば、
 既存の結合データとは別に、新しいグループを追加することもあるんですか?
 
こういった全般的な考え方のようなものを、細かい話に先立ってしてもらったほうが
有益な議論になると思うのですが、いかがですか。

投稿日時: 20/03/12 21:18:49
投稿者: やさは

mattuwan44様
マルチポストがダメはきがつかなかったのですが、問題があれば削除させていただきます。
  
  
>項目のセル(B列)クリックでマクロ起動に変えてみてはいかがでしょう?
  
と言いますのは…?
現在は使うときはボタンを押す形式にしていますが
1セットごとにトリガーを設定するということでしょうか?
  
  
あちらの掲示板に自身で記載したマクロで
セルの結合を繰り返して線を引く方法も考えはしたのですが
結合する範囲の指定が難しく断念しました。
  
一番最後を割り出してそこに追加をすることができるのであれば
その位置が割り出せれば最後のセルという条件付けをせず
このセルのある行という形に変更できないかなと思いました。
  
WinArrow様
先ほどと同じ回答になってしまいますがそれも考えて、一度作成していますが
複数のものとなった時に希望道理の形にできず断念しています。
  
Sub 行の追加()
 Dim r As Range
 Set r = Range("D" & Rows.Count).End(xlUp)
 Rows(r.Row).Copy
 Range("A" & r.Row + 1).PasteSpecial Paste:=xlPasteFormats '貼り付け
 r.Offset(1).Value = r.Value + 1
 Application.CutCopyMode = False
 Range("A4", "A" & r.Row + 1).Merge 'セルの結合
 Range("B14", "C" & r.Row + 1).Merge 'セルの結合
 Range("B14", "C" & r.Row + 1).Borders.LineStyle = xlContinuous 'セルに線を引く
End Sub
  
こちらですと単品の時はいいのですが
複数のセットが並んでいるときにも一番下しか行が増えない
A、Bともに変数になっていないため全部が結合されてしまうといった問題が起きました

投稿日時: 20/03/12 21:40:25
投稿者: やさは

simple様
気が回らず申し訳ありません。
  
http://www.excel.studio-kazu.jp/cgi-bin/kazuwiki2.cgi?mycmd=read&mypage=[[20200311132920]]
  
こちらでも、質問をさせていただいております。
他の方の方法も参考にできればと思い投稿いたしました。
  
・結合セルにするための基準はなんですか?
基準として設けているわけではありませんが
フォーマットとして結合されたセルがあります。
  
・そして、挿入したときには、結合セルとの関係ではどういうルールになっているんですか?
どういうルールというのがわかりませんがフォーマットを崩さないために結合セルをそのままにしたいです。
  
・既存の結合データのなかの最終行に追加するケースもあれば、
 既存の結合データとは別に、新しいグループを追加することもあるんですか?
記載されているものを参考にお伝えしますと。
  
A1〜AG19が基本的な1つの入力フォームになっています
追加される場合は一行開けたしたにA1〜AG19の基本が貼り付けられるようになっています。
  
A1〜A19が結合されていて、ナンバーが入っています。
A1〜AG14は固定の項目と入力部分があり
B15〜C19が結合されて項目名が入っています。
D15〜AG19部分にまた入力するところがあるのですが。
こちらに追加ができるようにしたいです。
  
  
その為、Aの結合セルを選択してマクロを実行すると
そのセットの中で行を増やす動作を行いたいです

回答
投稿日時: 20/03/12 22:36:38
投稿者: WinArrow
投稿者のウェブサイトに移動

>その為、Aの結合セルを選択してマクロを実行すると
> そのセットの中で行を増やす動作を行いたいです
 
まず、
結合セルとOFFSETは、相性がよくないです。
従って、結合セルの最終行を求めるのに、OFFSETを使うと、意図する行番号を取得できません。
 
結合セルの最終行を求めるコード例
 
    If ActiveCell.MergeCells Then
        Debug.Print ActiveCell.Row + ActiveCell.MergeArea.Rows.Count - 1
    End If
 
 
でも、結合セルの最終行の下に行追加は、難しいので
最終行を複写します。

Dim LastRow As Long
 
    If ActiveCell.MergeCells Then
        LastRow = ActiveCell.Row + ActiveCell.MergeArea.Rows.Count - 1
    End If
    Rows(LastRow).Copy
    Range("A" & LastRow).Insert Shift:=xlDown
    Application.CutCopyMode = False
 

回答
投稿日時: 20/03/13 13:42:55
投稿者: simple

既にWinArrowさんが指摘されています。
加えて、D列の連番は、

    'D列のNoをカウントアップ
    Cells(LastRow + 1, "D").Value = Cells(LastRow, "D").Value + 1
とすればよいです。

回答
投稿日時: 20/03/13 18:20:44
投稿者: mattuwan44

>mattuwan44様
>マルチポストがダメはきがつかなかったのですが、問題があれば削除させていただきます。
 
えっとですね。
リアルの世界では出会う人出会う人に質問したり、
思いつくとこに電話かけまくったりすることも多いと思うんですけど、
掲示板っていう形態が、すでに広く意見やアドバイスを求めている状況になっているわけです。
で、回答側も考えてみてもいつ他の回答者の回答で解決になるか解らないなかで、
回答を考えてくれているわけです。
とくにマクロとかの質問だと、
一言、「こうすればいいよ」的な話で終わらないことが多いので、
回答側もそれなりに時間を使っているわけです。
まだ、話しの進行状況が分かるうちはいいですが、
知らないとこで知らないうちに話が進んでいて解決していたときの、
徒労感は半端ないです。
そういうことを気遣っていただけると助かります。
なので、あちらの掲示板にも同じようにこっちでも聞いてますと、
知らせるのは礼儀だと思いますよ?
 
あと、大抵みなさん複数の掲示板を見回って、興味深い話題を探してますので、
どこの掲示板に行ってもマルチポストはわかりますし、
みなさん無駄な徒労は避けたいと思っているので、だれかが気づいて知らせてくれます。
あと、掲示板移動して回答者が多少変わっても、言われることはほぼいっしょです。
まぁ、たまに目から鱗の素晴らしいアイデアが出ることがあるかも知れませんが、、、、
 
とりあえず、シート上のイメージはこういうことですか?
                                                                                                  

                                                                                    
          [A]   [B]   [C]   [D]   [E]   [F]   [G]   [H]   [I]   [J]   [K]   〜[AG]  
    [13]                                                                            
        ┌──┬─────┬─────┬────────┬────────┐        
    [14]│ あ │   項目   │   No.    │       a        │       b        │        
        │    ├─────┼─────┼────────┼────────┤        
    [15]│    │          │    1     │       11       │      101       │        
        │    │          ├─────┼────────┼────────┤        
    [16]│    │          │    2     │       12       │      102       │        
        │    │          ├─────┼────────┼────────┤        
    [17]│    │    1     │    3     │       13       │      103       │        
        │    │          ├─────┼────────┼────────┤        
    [18]│    │          │    4     │       14       │      104       │        
        │    │          ├─────┼────────┼────────┤        
    [19]│    │          │    5     │       15       │      105       │        
        └──┴─────┴─────┴────────┴────────┘        
    [20]                                                                            
        ┌──┬─────┬─────┬────────┬────────┐        
    [21]│ い │   項目   │   No.    │       a        │       b        │        
        │    ├─────┼─────┼────────┼────────┤        
    [22]│    │          │    1     │      201       │       11       │        
        │    │          ├─────┼────────┼────────┤        
    [23]│    │          │    2     │      201       │       12       │        
        │    │          ├─────┼────────┼────────┤        
    [24]│    │    2     │    3     │      201       │       13       │        
        │    │          ├─────┼────────┼────────┤        
    [25]│    │          │    4     │      201       │       14       │        
        │    │          ├─────┼────────┼────────┤        
    [26]│    │          │    5     │      201       │       15       │        
        └──┴─────┴─────┴────────┴────────┘        
    [27]                                                                            
        ┌──┬─────┬─────┬────────┬────────┐        
    [28]│ う │   項目   │   No.    │       a        │       b        │        
        │    ├─────┼─────┼────────┼────────┤        
    [29]│    │          │    1     │      2001      │       11       │        
        │    │          ├─────┼────────┼────────┤        
    [30]│    │          │    2     │      2002      │       12       │        
        │    │          ├─────┼────────┼────────┤        
    [31]│    │    3     │    3     │      2003      │       13       │        
        │    │          ├─────┼────────┼────────┤        
    [32]│    │          │    4     │      2004      │       14       │        
        │    │          ├─────┼────────┼────────┤        
    [33]│    │          │    5     │      2005      │       15       │        
        └──┴─────┴─────┴────────┴────────┘        
    [34]                                                                            
                                                                                    
                                                                                          

 
基準とかルールというのは、会社の話ではなく、
作業のルール、作業するための基準ということです。
 
マクロを作るというのは、
作業を自動で行ってもらうように書く作業手順書を作るということです。
なので、その作業を他人にしてもらうのと同じように、
エクセル君に指示してやればいい話なのです。
 
なので、今回の件の場合、
例えば項目が「2」セル範囲を例えば「ダブルクリックしたら」、
そのセルを含む表の最終行の下に1行追加したいということですよね?
(結合セルを使うと、結合されたセルの左上セル以外は無効になっちゃうんで、
無効のセルを操作出来ないので、結合セルを使うと、
マクロが結構難しくなっちゃいます。)
 
まずは、その辺のルールを含めた前提条件(シート上の状態)を明確にしないと、
話しが進まないかな?
 
あと、いろいろ聞いて回るってことは、急いでいるのかな?
掲示板で早い解決は望まない方がいいです。
マクロを作るのは、やさはさんであり、回答者ではありません。
作る人が理解できてないのに早い解決は無理でしょう。
また、掲示板は無料でコードを書いてくれる場ではありません。
 
その辺はご理解いただけると、幸いです。
小理屈ばかりですみません。

回答
投稿日時: 20/03/13 19:42:28
投稿者: mattuwan44

該当シートのシートモジュールへ以下を記入
 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim c As Range

    If Target.Column > 1 Then Exit Sub
    If Target.Row < 14 Then Exit Sub
    If Target.MergeCells = False Then Exit Sub
    Cancel = True

    With Target.CurrentRegion
        Set Target = .Rows(.Rows.Count)
    End With

    With Target
        .EntireRow.Copy
        .Insert
        .Offset(0, 3).Resize(.Columns.Count - 3).ClearContents
        .Cells(0, 4).Resize(2).DataSeries
        .Cells(1).Select
    End With
End Sub

 
コピーして同じ行の前に挿入って目から鱗でしたね^^
やられたなぁ。。。。

回答
投稿日時: 20/03/13 19:43:49
投稿者: mattuwan44

あ。
A列の結合セルをダブルクリックでマクロ起動です。

回答
投稿日時: 20/03/14 23:27:24
投稿者: simple

今までの皆さんの回答で解決した部分はどこですか?
まだ残っている部分はどこですか?
一度整理していただけませんか?

回答
投稿日時: 20/03/14 23:49:08
投稿者: simple

というのは、そんなつもりはないと思いますが、
質問者は気に入った回答だけをつまみぐいするということではないんですよ。
出された回答を確認し、その結果をコミュニティに報告して頂く必要があるのです。
それが、ボランティアで運営されているこうした質問掲示板の基本的な考え方なんです。
これによって閲覧者も含めて、お互いにサポートしあえることになるわけです。
他の掲示板にセカンドオピニオンを尋ねるのもよいが、
それに伴う責任も果たしていただきたいのです。
よろしくお願いします。

投稿日時: 20/03/16 09:57:43
投稿者: やさは

返答が遅くなり大変申し訳ございません。
言い訳になってしまいますが会議資料の作成等でこちらの作業を後回しにしてしまいました。
 
WinArrow様
simple様
 
ありがとうございます!
ほぼ理想的になりました。
 
最後の行の入力フォームにデータがあるとそれも一緒にコピーされてしまったので
 
  Sub 行の追加()
 
  Dim LastRow As Long
  
    If ActiveCell.MergeCells Then
        LastRow = ActiveCell.Row + ActiveCell.MergeArea.Rows.Count - 1
    End If
    Rows(LastRow).Copy
    Range("A" & LastRow).Insert Shift:=xlDown
    Application.CutCopyMode = False
 '入力されている部分の削除
   Range("E" & LastRow + 1, "AG" & LastRow + 1).ClearContents
  'D列のNoをカウントアップ
    Cells(LastRow + 1, "D").Value = Cells(LastRow, "D").Value + 1
 
  End Sub
 
前に、使ったもので対応してみました。
使い方がよくないかもしれないですが…。
 
今度、時間をとってセット追加の部分の数字を自動にしたりと今回のものを元に試してみたいと思います!
この度はご協力いただきありがとうございました!
 
mattuwan44様
 
ご意見等ありがとうございます。
確かに期限が決まっているもので、調べながらやっていたけど全然わからず期限が迫っていたので
すがるような気持ちで見つけた掲示板に投稿させていただいておりましたので…
次からは気をつけたいと思います。
 
なおダブルクリックの件ですが、
セルの内容を変更することがある為、間違ってダブルクリックをしてしまうとその後の対応が 
使用者ができない可能性があります。
 
なので、明確にボタン等で対応できるようにしたいと思います。