[[20080207102407]]　『リストボックスの値をセルに記述する』（ひで）　ページの最後に飛ぶ

『リストボックスの値をセルに記述する』（ひで）

 VBA初心者です。よろしくお願いいたします。

 ユーザーフォーム上にリストボックスを貼り付け

 Rowsourceに範囲を設定し、選択したデータをセルに記述する方法について教えてください。
 どこに何を書いたり、設定したりすればよいのでしょうか。

 たとえば現在のアクティブセルの列がＤだった場合
 ユーザーフォーム上のテキストボックスが
 Ｄ列上のアクティブセル行のデータを表示す るように設定してあります。

 ここでリストボックス内のデータをクリック（確定ボタンが必要？）すると、

 ＡＷ列のアクティブセル行に入力されるようにしたいのです。

 また、隣のＥ列だった場合は

 ＡＹ列のアクティブセル（1行空かし）に入るようにしたいのです。

 図で書くと(［ ］はユーザーフォーム上のアクティブセルを表しています。）

 例１
 　　　　Ｄ　　Ｅ　　Ｆ・・・・・・・AW　　　　　　AX　　　　　　　AY

 12   ［　　］　　　　　　　　 ［AW12に入る］

 例2
   　　　Ｄ　　Ｅ　　Ｆ・・・・・・・AW　　　　　　AX　　　　　　　AY

 13　　　 　［　　］　　　　　　　　　　　　　　　　　　　　　［AY13に入る］

 という具合です。
 よろしくお願いいたします。

 ListBoxの名前が ListBox1
 UserFormモジュールへ貼り付け
 UserFormのデザイン画面でフォームを右クリックして「コードの表示」

 Private Sub LlistBox1_Click()
 With ListBox1
     If .ListIndex > -1 Then
         If ActiveCell.Column = 4 Then
             Range("aw" & ActiveCell.Row).Value = .Value
         ElseIf ActiveCell.Column = 5 Then
             Rnage("ay" & ActiveCell.Row).Value = .Value
         End If
     End If
 End With
 End Sub
 (seiya)

 seiyaさん。早速ありがとうございます。できました。

 もう一つお願いできますか。

 元のセル（D列12～AH列53）には数式でデータ（△、□など）が表示されていたり、
 空欄表示になっています。

 ここが空欄でなのに、リストボックス内データを選択しようとしたとき
 メッセージボックスを表示させることが可能でしょうか。（ひで）

 seiyaさん。早速確かめてみましたが、
 一つ私の言い方が悪かった部分があります。

 元のデータ入力するセルは
 D列～AH列です。
 また、リストボックスにて入力するセルは
 AW列～DE列まであります。

 作っていただいたコードはD,E列のみですよね。
 追加する方法を教えていただければ自分で書いてみます。

 （ひで）

      If .ListIndex > -1 Then
         If ActiveCell.Column = 4 Then
             Range("aw" & ActiveCell.Row).Value = .Value
         ElseIf ActiveCell.Column = 5 Then
             Rnage("ay" & ActiveCell.Row).Value = .Value
         End If
     End If

 の部分を

      If .ListIndex > -1 Then
         ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column * 2 + 41).Value = .Value
      End If
 に変更

 >  ここが空欄でなのに、リストボックス内データを選択しようとしたとき
 > メッセージボックスを表示させることが可能でしょうか。
 よく意味がわからないのですが？
 (seiya)

 ありがとうございます。と同時に、すみません。タイプミスです。

 まずD列～DE列には数式が入っており、○や△や空欄表示になっています。

 たとえば

 D12＝数式によって○や△が表示されている
　　　　　↓
 D12がアクティブになっているときリストボックスにて
 AW12にデータを入力しようとするとそのままリス トボックス内データが入力できる。

 しかし

 D12＝数式によって空欄になっている
　　　　　↓
 D12がアクティブになっているときリストボックスにて
 AW12にデータを入力しようとすると
 メッセージボックスが表示される
 ”D12にデータを入れてください”

 という具合です。

 これがD12:AH53内のセルに適応させたいのですが。。。
 （ひで）

 こんな感じですか？

 Private Sub LlistBox1_Click()
 With ListBox1
     If .ListIndex > -1 Then
         If Intersect(ActiveCell, Range("d12:ah53")) Is Nothing then Exit Sub
         If ActiveCell = "" Then
             MsgBox ActiveCell.Address(0,0) & " にデータを入れてください"
             Exit Sub
         End If
         ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column * 2 + 41).Value = .Value
     End If
 End With
 End Sub
 (seiya)

 seiyaさん。返信が遅くなってすみません。完璧にできました。
 感謝いたします。またよろしくお願いいたします。
 （ひで）

seiyaさん。できたと思っていたらもう一つ問題が起きました。

 たとえば

 D12セルをアクティブにし，リストボックス内からデータを選択したとします。
 この場合たとえば「あ」がAW12に入力され，リストボックス内も「あ」が選択されています。
 このアクティブセルを上下左右に移動したときに
 先ほどD12の時に選択した「あ」がそのまま選択されて(青く反転）いますが，
 たとえばD13が未入力だったときに選択されている「あ」の反転をなくすにはどうすればよいでしょう か。
 さらに既に入力済みのD12に移動したときには再び「あ」が反転するという具合に

　元のセル（D列12～AH列53）内でセルを移動したときにリストボックスで

 反転させた（選択した）セルはそのまま反転させ，何も選択したなかったセルは反転をさせない
 これをセルの移動とともに連動させることは可能でしょうか。（ひで）

 > たとえばD13が未入力だったときに選択されている「あ」の反転をなくすにはどうすればよいでしょうか。
 If ActiveCell = "" Then
     .ListIndex = -1 '<- この行を追加

 > さらに既に入力済みのD12に移動したときには再び「あ」が反転するという具合に
 入力済みか否かは ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column * 2 + 41)に値があるか否かで
 判断するのですか？
 ActiveCell の値はこちらにはわかりませんので。
 (seiya)

 > さらに既に入力済みのD12に移動したときには再び「あ」が反転するという具合に
  入力済みか否かは ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column * 2 + 41)に値があるか否 かで
  判断するのですか？

 できればそうしたいです。

 しかし，D列12～AH列53内アクティブセルに「△」「□」「キ」「テ」が入力されたとき
 リストボックスから追加データを選択するようにしたいので
 アクティブセルにこれら4つの文字が入力されているとき
 反転させるのでも大丈夫だと思います。
 （ひで）

 If ActiveCell = "" Then
     .ListIndex = -1 '<- この行を追加

追加しました。左に移動して空欄セルをアクティブにしましたが，
D12で選択した反転が消えないのですが。。。
（ひで）

 その下に
 DoEvents
 を追加してみてください。
 (seiya)

 >  しかし，D列12～AH列53内アクティブセルに「△」「□」「キ」「テ」が入力されたとき
 > リストボックスから追加データを選択するようにしたいので
 > アクティブセルにこれら4つの文字が入力されているとき
 > 反転させるのでも大丈夫だと思います。

 ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column * 2 + 41)にある値を選択する
 ということですか？
 ListBox の中にその値が含まれていない場合もあるのですか？
 (seiya)

 リストボックスによって入力するAW列～DE列内
 にはリストボックスの中に含まれない値はありません。
 ただ，28個のデータがあります。
 一つ一つ設定しなければなりませんか。
 （ひで）

 ということは、WorksheetのSelectionChange event で制御ですね？
 Userformのコードを元に戻して

 シートモジュールへ

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 With Target
     If Intersect(.Cells, Range("d12:ah53")) Is Nothing Then Exit Sub
     If .Value = "" Then
         UserForm1.ListBox1.ListIndex = -1
         DoEvents
         Exit Sub
     Else
         UserForm1.ListBox1.Value = Cells(.Row, .Column * 2 + 41).Value
         DoEvents
     End If
 End With
 End Sub
 (seiya)

Userformのコードを元に戻すってことは

If ActiveCell = "" Then

     .ListIndex = -1 '<- この行を追加    <=この行を削除ですか。

（ひで）

 そうです。
 (seiya)

正常に動いているようです。

お手数をおかけしました。

ありがとうございます。

（ひで）

Sub tatekeisen3()’罫線を縦に引く
'
' tatekeisen2 Macro
'

    Range("D12:D53,I12:I53,N12:N53,S12:S53,X12:X53,AC12:AC53,AH12:AH53,AI12:AI53"). _
        Select
    Range("AI12").Activate
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub saikeisen()’罫線を横に引く
'
' saikeisen Macro
'

 Range("B16:AL16,B21:AL21,B26:AL26,B31:AL31,B36:AL36,B41:AL41,B46:AL46,B51:AL51,B53:AL53").Select

  '  With Selection.Borders(xlEdgeLeft)
  '      .LineStyle = xlContinuous
  '      .ColorIndex = 0
  '      .TintAndShade = 0
  '      .Weight = xlMedium
  '  End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
  '      .ColorIndex = 0
  '      .TintAndShade = 0
        .Weight = xlThin
    End With
  '  With Selection.Borders(xlEdgeRight)
  '      .LineStyle = xlContinuous
  '      .ColorIndex = 0
  '      .TintAndShade = 0
  '      .Weight = xlHairline
  '  End With
  '  Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("AG12").Select 
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
の2つのマクロを実行し、罫線を引こうとすると

If .Value = "" Then

にエラーが出るのですが、

どうすればいいのでしょうか。

また、このエラーは行、列などを範囲設定し、

d12:ah53が含まれるとエラーが発生するようですね。

たびたび申し訳ありません。（ひで）

 With Target
     If .Count > 1 Then Exit Sub '<- この行を追加
 (seiya)

ありがとうございます。わかる人にとっては簡単なんですね。すごいです。

（ひで）

 Select するコードは避けたほうがよいですよ？

 Sub saikeisen()’罫線を横に引く

 ' saikeisen Macro

 With Range("B16:AL16,B21:AL21,B26:AL26,B31:AL31,B36:AL36,B41:AL41,B46:AL46,B51:AL51,B53:AL53")

    .Borders(xlEdgeLeft).Weight = xlMedium

    .Borders(xlEdgeBottom).Weight = xlThin

    .Borders(xlEdgeRight).Weight = xlHairline
 End With
 End Sub
 (seiya)

コメント返信：

[ 一覧(最新更新順) ]

[[20080207102407]] 『リストボックスの値をセルに記述する』（ひで） ページの最後に飛ぶ

[[20080207102407]]　『リストボックスの値をセルに記述する』（ひで）　ページの最後に飛ぶ