[[20080614120403]] 『チェックボックスを使って行の挿入』(MAKO) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『チェックボックスを使って行の挿入』(MAKO)

 こんなことは可能でしょうか?

 基準となる書式フォームをエクセルで作成しているのですが、
 別枠のいくつかの文字列(文章)リストのそれぞれ先頭に2つのチェックボックスをつけて
 チェックを入れると指定のセルの下に番号を振って順番に挿入していくこと。

   A  B  C  D  F   〜  AA  AB  AC

 1 カテゴリーa          a   b
 2 カテゴリーb          □  □  あいうえお
 3                 □  □  かきくけこ  
 4                 □  □  さしすせそ
 5                 □  □  たちつてと

 例えば上記のような表でA1:Z50位が印刷の書面、AA2にチェックを入れた場合、
 A2に「(1)あいうえお」と挿入、続けてAA5にチェックを入れるとその下に「(2)たちつてと」が挿入、A
 B3にチェックを入れると、2.カテゴリーbの下に「(1)かきくけこ」という具合です。

 リストはカテゴリーA、カテゴリーB、またはいずれでもない(挿入なし)で重複はしません。

 当然、AA1〜AC5のリストは挿入で崩れるのであればAA50:AC55にリスト作成は問題ありません。

 挿入のセルアドレスがそのつど変わるので無理でしょうか?

 VBAの基礎もわからず、こちらの質問ボードでコードを教えてもらい、セルをチェックボックスとして使っています。
 もし、挿入が無理であれば、カテゴリーAとカテゴリーBをのセルを間隔をあけて固定して
 その下に(1)〜(5)番号を振っておき、チェックをした順番に入るという形でも結構です。

 もし、お分かりになる方がいたら教えてください。よろしくお願いします。

 >もし、挿入が無理であれば、カテゴリーAとカテゴリーBをのセルを間隔をあけて固定して
 >その下に(1)〜(5)番号を振っておき、チェックをした順番に入るという形でも結構です。 
 無理と云うことはないと思いますが、簡単な方で (^^ゞ

 数式で対応する案(実際のデータも少量と想定しています。沢山あるなら適切な方法ではありません。)

 (1) A2セル 下にコピー
    =IF(COUNTIF(AA$2:AA$5,"■")<ROW(ZZ1),"","("&ROW(ZZ1)&")"&INDEX(AC$1:AC$5,1/LARGE(INDEX((AA$2:AA$5="■")/ROW(ZZ$2:ZZ$5),0),ROW(ZZ1))))

 (2) A7セル 下にコピー
    =IF(COUNTIF(AB$2:AB$5,"■")<ROW(ZZ1),"","("&ROW(ZZ1)&")"&INDEX(AC$1:AC$5,1/LARGE(INDEX((AB$2:AB$5="■")/ROW(ZZ$2:ZZ$5),0),ROW(ZZ1))))

 <結果図>
 行   _______A_______  _B_          _AA_  _AB_  ____AC____  
  1   1.カテゴリーa               a     b                 
  2   (1)あいうえお                 ■          あいうえお  
  3   (2)かきくけこ                 ■          かきくけこ  
  4   (3)たちつてと                       ■    さしすせそ  
  5                                 ■          たちつてと  
  6   2.カテゴリーb                                       
  7   (1)さしすせそ                                         
  8         

  (半平太)

半平太さん、またまたお助けありがとうございます。

VBAぢゃなくっても、計算式で出来るんですね。すごい…。

あまえついでに、もし挿入が可能ならまた教えてください…

(MAKO)


 >もし、挿入が無理であれば、カテゴリーAとカテゴリーBをのセルを間隔をあけて固定して
 『無理であれば』でしたね。m(__)m

 一つの数式だと、同じ計算を何度も行う無駄の多いものになります。

 以下、マクロ案

 Sub Macro1()
    Dim lastRow As Long
    Dim CatgA, CatgB
    Dim DTtoProc As Range
    Dim Cel As Range
    Dim strtB As Range

    lastRow = Range("AC65536").End(xlUp).Row
    If lastRow = 1 Then Exit Sub

    Range("A2:A" & lastRow).Formula = "=IF(AA2=""■"",1,IF(AB2=""■"",2,""""))"

    Set DTtoProc = Range("A2:A" & lastRow)

    CatgA = Array()
    CatgB = Array()

    For Each Cel In DTtoProc
        If Cel.Value = 1 Then
            ReDim Preserve CatgA(UBound(CatgA) + 1)
            CatgA(UBound(CatgA)) = "(" & UBound(CatgA) + 1 & ")" & Cel.Range("AC1").Value
        ElseIf Cel.Value = 2 Then
            ReDim Preserve CatgB(UBound(CatgB) + 1)
            CatgB(UBound(CatgB)) = "(" & UBound(CatgB) + 1 & ")" & Cel.Range("AC1").Value
        End If
    Next Cel

    Range("A:A").ClearContents

    If UBound(CatgA) >= LBound(CatgA) Then
        Range("A1").Value = "1.カテゴリa"
        Range("A2").Resize(UBound(CatgA) + 1).Value = _
                        WorksheetFunction.Transpose(CatgA)
    End If
    If UBound(CatgB) >= LBound(CatgB) Then
        Set strtB = Range("A65536").End(xlUp).Offset(1 + (UBound(CatgA) < LBound(CatgA)))
        strtB.Range("A1").Value = "2.カテゴリb"
        strtB.Range("A2").Resize(UBound(CatgB) + 1).Value = _
                        WorksheetFunction.Transpose(CatgB)
    End If
 End Sub

 (半平太)

半平太さん、ありがとうございます。

ちょっと身の程知らずな質問だったようで、いただいたコードをどのように活用したらよいかわかりません。スイマセン…。

ダブルクリックでチェックするコード

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

 Dim flag As Object
 Const adr As String = "aa1:ab5"

 Set flag = Application.Intersect(Target, Range(adr))
 If flag Is Nothing Then Exit Sub

 Cancel = True
 If Target.Value = "■" Then
    Target.Value = Clear
 Else
    Target.Value = "■"
 End If
 End Sub

の後にそのまま貼り付けしても動かないようですし、また実際の書式に使おうにも、どの変のコードを変えればよいかよくわからないのです。

よろしければもう少しご教授をお願いします…。

(MAKO)


 >Target.Value = Clear
         ↑
 1.実際にこのステートメントはワークしていますか?

 >Const adr As String = "aa1:ab5"
               ↑
 2."■"の入る範囲が、ご質問のレイアウトと違いませんか?
    (1行目は「a」か「b」のタイトルのハズですが、、)

 >リストはカテゴリーA、カテゴリーB、またはいずれでもない(挿入なし)で重複はしません。
                                    ↑
 3.ご提示のコードだと、"■"は同一行に2つ存在し得ると思うのですが、重複しないと断言できる根拠はなんですか?
   ・・・もしくは「重複なし」とはどんな意味ですか?

 (半平太)

半平太さん

申し訳ありません。前段申し上げたように身の程知らずだったと思いますが、
いただいたご質問の意味がわかりません。何しろVBAは意味もわからずコピーして、いろいろ試して
アドレス等を変更して使用させていただいているだけなので…。

1.に関してはコードの意味がわからず使用しているので答えられません。

2.はおっしゃるとおり間違えてました。私の理解しうる範囲であれば"aa2:ab5"ですね。

3.は提示のコードはあくまでコピーして使えるコードがそれだっただけで"aa2:ab5"に"■"を入れるためのコードとして入れました。コードとしてはカテゴリーA,Bのチェック(■)は重複しますが、「重複しません。」といったのは、コードのことではなく、作成書式の性質上「いずれかの振り分けである」という説明をさせていただいた次第です。

具体的には、教えていただいたコードはどのようにして活用するのでしょうか?

(MAKO)


 >1.に関してはコードの意味がわからず使用しているので答えられません。 
 単に「エラー」が発生していないかってことなのですけど。
 当方は自信がないので、Clearの代わりに→ "" にします。
  
  
 >2.はおっしゃるとおり間違えてました。私の理解しうる範囲であれば"aa2:ab5"ですね。 
 当初の理解が正しいものとして、aa2に変更します。
  
  
 >3.は提示のコードはあくまでコピーして使えるコードがそれだっただけで"aa2:ab5"に"■"を入れるためのコードとして入れました。
 >コードとしてはカテゴリーA,Bのチェック(■)は重複しますが、
 >「重複しません。」といったのは、コードのことではなく、作成書式の性質上「いずれかの振り分けである」 
 人が目で見て重複させない(重複していたら、手で解消する)と云う意味に理解することにします。
  
  
 >具体的には、教えていただいたコードはどのようにして活用するのでしょうか? 
 全部入れ替え方式ですと、下記になると思います。(ご提示のコードはほとんど変更ありません)

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

 Dim flag As Object
 Const adr As String = "aa2:ab5"  'ここ変更1/2

  Set flag = Application.Intersect(Target, Range(adr))
  If flag Is Nothing Then Exit Sub

  Cancel = True
  If Target.Value = "■" Then
     Target.Value = ""        'ここ変更2/2。Clearの代わり
  Else
    Target.Value = "■"
  End If

  Macro1 'ここ追加1/1。 Macro1実行

  End Sub

 Sub Macro1()
    Dim lastRow As Long
    Dim CatgA, CatgB
    Dim DTtoProc As Range
    Dim Cel As Range
    Dim strtB As Range

    lastRow = Range("AC65536").End(xlUp).Row
    If lastRow = 1 Then Exit Sub

    Range("A2:A" & lastRow).Formula = "=IF(AA2=""■"",1,IF(AB2=""■"",2,""""))"

    Set DTtoProc = Range("A2:A" & lastRow)

    CatgA = Array()
    CatgB = Array()

    For Each Cel In DTtoProc
        If Cel.Value = 1 Then
            ReDim Preserve CatgA(UBound(CatgA) + 1)
            CatgA(UBound(CatgA)) = "(" & UBound(CatgA) + 1 & ")" & Cel.Range("AC1").Value
        ElseIf Cel.Value = 2 Then
            ReDim Preserve CatgB(UBound(CatgB) + 1)
            CatgB(UBound(CatgB)) = "(" & UBound(CatgB) + 1 & ")" & Cel.Range("AC1").Value
        End If
    Next Cel

   Application.ScreenUpdating = False

        Range("A:A").ClearContents

        If UBound(CatgA) >= LBound(CatgA) Then
            Range("A1").Value = "1.カテゴリa"
            Range("A2").Resize(UBound(CatgA) + 1).Value = _
                            WorksheetFunction.Transpose(CatgA)
        End If
        If UBound(CatgB) >= LBound(CatgB) Then
            Set strtB = Range("A65536").End(xlUp).Offset(1 + (UBound(CatgA) < LBound(CatgA)))
            strtB.Range("A1").Value = "2.カテゴリb"
            strtB.Range("A2").Resize(UBound(CatgB) + 1).Value = _
                            WorksheetFunction.Transpose(CatgB)
        End If
   Application.ScreenUpdating = True

 End Sub

 (半平太)

 <追記 6/17 5:00>
 1.ダブルクリック一回毎に、Macro1が走ると云うナンセンスに近いマッチイングになっています。
   初めにそう云う使い方するとお聞きしていないので、本件やむを得ず。

 2.■を全部入れ終わってから、一回だけMacro1を走らせるのであれば、まあ正常な使い方と云えます。

 3.もっと使い勝手のいいものが他の方から提示されるかも知れません。そうなると良いのですが。
   (私は一回作っちゃったので、仕切り直しする気はありません。)

 >>Target.Value = Clear
 >        ↑
 >1.実際にこのステートメントはワークしていますか?
 
Option Explicit の宣言がない場合、予約語Clearは暗黙宣言の変数と認識されているよう
です。変数Clearには値が代入されていないので、 Target.Value = "" を実行したのと同
じ結果になるだけでしょう。本来は、
 
Target.Clear
 
としたかったのかも。
(みやほりん)(-_∂)b

 >変数Clearには値が代入されていないので、 Target.Value = "" を実行したのと同じ結果になるだけでしょう。
 「だけでしょう」?

 それはどう云うニュアンスなんですか?

 みやほりんさんのカキコの内容は、百も承知です。
 その上で、私は Clear→"" に代える回答を付けたのです。

 質問者の示す情報は不足していることが多いです。
 提示されたコードも明示された仕様に基づいたものでもありません。

 >Target.Clear としたかったのかも。
 この可能性はすごく小さいと思っています。
 せいぜい、Target.Clearcontents です。

 あのステートメントがワークしていないなら、躊躇なく変更の提案ができます。
 もしワークしているなら、変更は控えめに提案するしかないです。

 ワークしている場合、必ずしも「 暗黙宣言の変数」に限定はされません(可能性は大ですけどね)。
 プロシージャの外で定義している可能性だってゼロではないです。
 しかし、そんなことを確かめるために更にやり取りしなければならない程の案件とも思いません。

 不十分な情報の中、「Clear」は素性の知れないものと云うしかなく、
 私は、不確かな状態を解消したく、同じ意味の可能性の高い("")に明示的に変える回答にする選択をした。

 それは「だけでしょう」なんてものではなく、質的に違うものです。
 (半平太)

 「[Target.Value = Clear は]Target.Value = "" を実行したのと同じ結果になるだけでしょう。」
であって、「だけ」と言う投げかけは省略した主体、[Target.Value = Clear は]であります。
Target.Value = "" は妥当性があります。
熟慮の結果を「だけ」と評価された、とお感じになられたのでしたら、私の表現の未熟さ、思慮の
欠如でありますので、謹んでここにお詫び申し上げます。
 
私の見解は下記。
(1)Option Explicit 宣言がない場合は、例え予約語であっても暗黙宣言の変数と認識される。
   (今回の場合は Clear がClearメソッドで使用されている予約語)
(2)そのため、間違ったステートメント記述もエラーなしで実行される場合がある。
(3)通常、間違ったステートメントは期待しない結果を返すものだが、Target.Value = Clear
   は、(1)の条件において、期待する結果(Target.Value = "" )と「たまたま」同じに
   なるだけである。エラーも出ないので、使用している人も不適切な記述に「たまたま」気
   が付かなかっただけである。
 
[MAKO]さんが不都合なくこのコードを利用できていたことと、[半平太]さんが「エラー」が発生
するのでは、と危惧したことには、ギャップを感じられる方が居られるでしょうから、補足的に
コメントいたしました。
 
さらに、婉曲的に Option Explicit 宣言の啓蒙を意図しております。
上記以上の意図はございません。
 
【参考】
[[20050508095758]] 『追加セルをクリックするとそのセルに"■"を表示』(ととろ)
 
(みやほりん)(-_∂)b


半平太さん、みやほりんさん、ありがとうございます。

お二人のやり取りは、私には高度すぎて理解できませんでしたが…。

確かに、私が提示したコードは、みやほりんさんが【参考】リンクしたととろさんの質問に対するramrunさんの回答を使用させていただいたものです。

半平太さんのご提示いただいたコードで、確かに私のリクエスト通りの動きになります。すごいですありがとうございます。
ただ、私の示した情報が不足していたのだと反省しておりますが、それぞれ全くチェックしない場合、「カテゴリーa」「カテゴリーb」といった表題も消えてしまうため、今回私が作成している書式で使うには当てはまらず、一番初めにご提示いただいた計算式を使用させていただきたいと思います。この場合、
チェックの数が少なかった場合に、カテゴリーaと終わりと表題の「カテゴリーb」の行間が開いてしまうのですが、見た目だけのことなので問題ないです。本当にありがとうございました。


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.