Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4554 / 13646 ツリー ←次へ | 前へ→

【55823】リストボックスを活用するには にしもり 08/5/20(火) 17:15 質問[未読]
【55843】Re:リストボックスを活用するには にしもり 08/5/21(水) 10:35 質問[未読]
【55847】Re:リストボックスを活用するには Yuki 08/5/21(水) 11:54 発言[未読]
【55851】Re:リストボックスを活用するには にしもり 08/5/21(水) 13:37 お礼[未読]
【55895】Re:リストボックスを活用するには にしもり 08/5/22(木) 18:27 質問[未読]
【55897】Re:リストボックスを活用するには カウボーイズ 08/5/22(木) 19:15 回答[未読]
【55899】Re:リストボックスを活用するには にしもり 08/5/22(木) 19:55 質問[未読]
【55900】Re:リストボックスを活用するには カウボーイズ 08/5/22(木) 20:15 回答[未読]
【55911】Re:リストボックスを活用するには にしもり 08/5/23(金) 10:54 お礼[未読]
【55912】Re:リストボックスを活用するには カウボーイズ 08/5/23(金) 11:44 回答[未読]
【55968】Re:リストボックスを活用するには にしもり 08/5/26(月) 17:10 質問[未読]
【55973】Re:リストボックスを活用するには にしもり 08/5/27(火) 16:08 質問[未読]
【55974】Re:リストボックスを活用するには Yuki 08/5/27(火) 16:18 発言[未読]
【55975】Re:リストボックスを活用するには にしもり 08/5/27(火) 16:28 お礼[未読]
【55976】Re:リストボックスを活用するには にしもり 08/5/27(火) 17:38 質問[未読]
【55978】Re:リストボックスを活用するには カウボーイズ 08/5/27(火) 22:25 回答[未読]
【55979】Re:リストボックスを活用するには カウボーイズ 08/5/28(水) 0:01 回答[未読]
【55983】Re:リストボックスを活用するには にしもり 08/5/28(水) 11:12 お礼[未読]

【55823】リストボックスを活用するには
質問  にしもり  - 08/5/20(火) 17:15 -

引用なし
パスワード
   こんにちは。
以前【54276】で皆様のお力で解決した従来の処理、すこしかえる必要が生じております。

-従来の処理-

(標準モジュール)
Option Explicit

Public i As Long
Public ws1 As Worksheet

Sub Sample()
 If Not Application.Intersect(Range("B3:B104"), ActiveCell) Is Nothing Then
  Set ws1 = Worksheets("history")
  i = ws1.Range("B65536").End(xlUp).Row + 1
  If i < 5 Then
   i = 5
  End If
 
  With ActiveCell
   ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
   ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
  End With
  UserForm1.Show
 Else
  MsgBox "Programのいずれかをアクティブにしてください。"
 End If
End Sub


(ユーザーフォーム)
Option Explicit

Private Sub UserForm_Initialize()
  Calendar1.Value = Date
'  カレンダーの日付をセルにセットする
   Dim i As Integer
    Me.TextBox1.Value = Date
    With Me.ComboBox1
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox2
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
    With Me.ComboBox3
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox4
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
'  カレンダーの日付をセルにセットする
End Sub

Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double

 If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
  From_Str = Me.ComboBox1.Value & ":" & Me.ComboBox2.Value
 End If
 If Me.ComboBox3.Value <> "" And Me.ComboBox4.Value <> "" Then
  To_Str = Me.ComboBox3.Value & ":" & Me.ComboBox4.Value
 End If
 If From_Str <> "" And To_Str <> "" Then
  Hours = (CDate(To_Str) - CDate(From_Str)) * 24
  'Date
  ws1.Cells(i, 5).Value = Me.TextBox1.Value
  'Time(From)
  ws1.Cells(i, 6).Value = CDate(From_Str)
  'Time(To)
  ws1.Cells(i, 7).Value = CDate(To_Str)
  'Hours
  ws1.Cells(i, 8).Value = (CDate(To_Str) - CDate(From_Str)) * 24
  'Place
  ws1.Cells(i, 10).Value = Me.TextBox2.Value
  'Notese
  ws1.Cells(i, 11).Value = Me.TextBox3.Value
 End If
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub


-かえたい点-

ユーザーフォームにリストボックスをおきたいです。
その際Mutliselect プロパティをfmMultiSelectExtendedで複数選択可とします。
その際、ポイントするリストはアクティヴシートでなく別のシート(シート名member)のA2:A51にあり、常にそこをさしたいです。中は社員名です。
なおmemberのB2:B51には社員名に対応する社員番号がCharacterで入っています。

それが解決できたら次にやりたい以下のとおりです。
(1)リストボックスで得た値が単数の場合、従来の処理にくわえ、worksheet"history"のi行m列にリストボックスで取得した社員名を、また、i行l列にリストボックスで取得した社員の社員番号を転記したい。
(2)リストボックスで得た値が複数の場合、
(2-1)従来の処理にくわえ、worksheet"history"のi行m列にリストボックスで取得した1番目の社員名を、また、i行l列にリストボックスで取得した1番目社員の社員番号を転記したい。
(2-2)次にworksheet"history"のi+1行m列にリストボックスで取得した2番目の社員名を、また、i+1行l列にリストボックスで取得した2番目の社員の社員番号を転記したい・・・という具合です。

そもそもアクティヴシート以外のシートの特定範囲を、リストボックスに表示するにはどうしたらよいかわかりません。
どなたかご教示くださいませんか。

【55843】Re:リストボックスを活用するには
質問  にしもり  - 08/5/21(水) 10:35 -

引用なし
パスワード
   自己レスです
ユーザーフォームにListBox1を設け、プロパティのRowSourceにSheet'member'!a2:b51 と入れてみましたがプロパティに値が無効、と出ます。
できるかぎり自力ですすめたいとかんがえていますが、市販本をみても無いのでどなたかご教示いただけるとたすかります。

【55847】Re:リストボックスを活用するには
発言  Yuki  - 08/5/21(水) 11:54 -

引用なし
パスワード
   ▼にしもり さん:
>ユーザーフォームにListBox1を設け、プロパティのRowSourceにSheet'member'!a2:b51 と入れてみましたがプロパティに値が無効、と出ます。

シートのオブジェクト名を指定
      ___↓_
RowSourceに Sheet1!a2:b51

コードで指定する時は
Me.ListBox1.RowSource = Worksheets("Sheet2").Range("A1:B10").Address(External:=True)
とかにすれば宜しいかと思います。

【55851】Re:リストボックスを活用するには
お礼  にしもり  - 08/5/21(水) 13:37 -

引用なし
パスワード
   ▼Yuki さん:
できました。ありがとうございました!

まだ先がありますが一歩前進という感じです。
自力ですすめてみて、おききしたい点がでたらまたおききしたいとぞんじます。

【55895】Re:リストボックスを活用するには
質問  にしもり  - 08/5/22(木) 18:27 -

引用なし
パスワード
   ユーザフォームにリストボックスをもうけました。
そして下記のようにロジックを追加している最中です。
市販本をみてなんとかここまできました。
ところが実行すると、Withステートメントのところで、「変数が定義されていません」とでてひっかかってしまいます。
どこが悪いのでしょうか。

(標準モジュール)

Option Explicit

Public i As Long
Public ws1 As Worksheet
Public MyCount As Integer
Public n As Long

Sub Sample()

With ListBox1 '←実行すると、「変数が定義されていません」とでてここでひっかかってしまいます。

MyCount = .ListBox1 - 1 ’←追加しました
  For n = 0 To MyCount ’←追加しました
    If (.Selected(n) = True) Then ’←追加しました
      If Not Application.Intersect(Range("C3:C104"), ActiveCell) Is Nothing Then
       Set ws1 = Worksheets("history")
       i = ws1.Range("B65536").End(xlUp).Row + 1
         If i < 5 Then
          i = 5
         End If
        
          With ActiveCell
           ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
           ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
          End With
        
        
         UserForm1.Show
      Else
         MsgBox "Programのいずれかを選択してください。"
      End If
    End If ’←追加しました
  Next n ’←追加しました
End With ’←追加しました
End Sub
ーーーーーーーーーーーーーーー--------------------------------------------------------------------------------------------

(ユーザーフォーム)
Option Explicit

Private Sub UserForm_Initialize()
  Calendar1.Value = Date
'  カレンダーの日付をセルにセットする
   Dim i As Integer

  Me.ListBox1.RowSource = Worksheets("member").Range("a2:a51").Address(external:=True) ’←追加しました

    Me.TextBox1.Value = Date
    With Me.ComboBox1
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox2
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
    With Me.ComboBox3
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox4
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
'  カレンダーの日付をセルにセットする
End Sub

Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double

 If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
  From_Str = Me.ComboBox1.Value & ":" & Me.ComboBox2.Value
 End If
 If Me.ComboBox3.Value <> "" And Me.ComboBox4.Value <> "" Then
  To_Str = Me.ComboBox3.Value & ":" & Me.ComboBox4.Value
 End If
 If From_Str <> "" And To_Str <> "" Then
  Hours = (CDate(To_Str) - CDate(From_Str)) * 24
  'Date
  ws1.Cells(i, 5).Value = Me.TextBox1.Value
  'Time(From)
  ws1.Cells(i, 6).Value = CDate(From_Str)
  'Time(To)
  ws1.Cells(i, 7).Value = CDate(To_Str)
  'Hours
  ws1.Cells(i, 8).Value = (CDate(To_Str) - CDate(From_Str)) * 24
  'Place
  ws1.Cells(i, 10).Value = Me.TextBox2.Value
  'Notese
  ws1.Cells(i, 11).Value = Me.TextBox3.Value
 End If
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub

【55897】Re:リストボックスを活用するには
回答  カウボーイズ  - 08/5/22(木) 19:15 -

引用なし
パスワード
   >With ListBox1 '←実行すると、「変数が定義されていません」とでてここでひっかかってしまいます

標準モジュールに記述してるからでは?
ユーザーフォームのリストボックスですよね?

標準モジュールに記述するなら、
UserForm1.ListBox1 のように親を書いてあげないと駄目だと思いますよ。

【55899】Re:リストボックスを活用するには
質問  にしもり  - 08/5/22(木) 19:55 -

引用なし
パスワード
   ▼カウボーイズ さん:
ありがとうございます。
この場合親を指定するのですね。
さっそくUserForm1と2箇所に加筆しました。
ですが今度は、Null値のつかいかたが不正とでます。
どこかがまだいけないのでしょうか。

(標準モジュール)
Option Explicit

Public i As Long
Public ws1 As Worksheet
Public MyCount As Integer
Public n As Long

Sub Sample()

With UserForm1.ListBox1 '←UserForm1と加筆しました

MyCount = UserForm1.ListBox1 - 1 '←UserForm1と加筆しました。が、Null値のつかいかたが不正とでます。
  For n = 0 To MyCount
    If (.Selected(n) = True) Then
      If Not Application.Intersect(Range("C3:C104"), ActiveCell) Is Nothing Then
       Set ws1 = Worksheets("history")
       i = ws1.Range("B65536").End(xlUp).Row + 1
         If i < 5 Then
          i = 5
         End If
    
          With ActiveCell
           ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
           ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
          End With
    
    
         UserForm1.Show
      Else
         MsgBox "Programのいずれかを選択してください。"
      End If
    End If
  Next n
End With
End Sub

(ユーザフォーム)
Option Explicit

Private Sub UserForm_Initialize()
  Calendar1.Value = Date
'  カレンダーの日付をセルにセットする
   Dim i As Integer

  Me.ListBox1.RowSource = Worksheets("member").Range("a2:a51").Address(external:=True) '←追加しました

    Me.TextBox1.Value = Date
    With Me.ComboBox1
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox2
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
    With Me.ComboBox3
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox4
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
'  カレンダーの日付をセルにセットする
End Sub

Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double

 If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
  From_Str = Me.ComboBox1.Value & ":" & Me.ComboBox2.Value
 End If
 If Me.ComboBox3.Value <> "" And Me.ComboBox4.Value <> "" Then
  To_Str = Me.ComboBox3.Value & ":" & Me.ComboBox4.Value
 End If
 If From_Str <> "" And To_Str <> "" Then
  Hours = (CDate(To_Str) - CDate(From_Str)) * 24
  'Date
  ws1.Cells(i, 5).Value = Me.TextBox1.Value
  'Time(From)
  ws1.Cells(i, 6).Value = CDate(From_Str)
  'Time(To)
  ws1.Cells(i, 7).Value = CDate(To_Str)
  'Hours
  ws1.Cells(i, 8).Value = (CDate(To_Str) - CDate(From_Str)) * 24
  'Place
  ws1.Cells(i, 10).Value = Me.TextBox2.Value
  'Notese
  ws1.Cells(i, 11).Value = Me.TextBox3.Value
 End If
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub

【55900】Re:リストボックスを活用するには
回答  カウボーイズ  - 08/5/22(木) 20:15 -

引用なし
パスワード
   >MyCount = UserForm1.ListBox1 - 1 '←UserForm1と加筆しました。が、Null値のつかいかたが不正とでます

細部まで見てませんが、MyCountはリストボックスのリスト数を代入したいのでしょうか?
その場合は、
MyCount = UserForm1.ListBox.ListCount
にしないといけません

【55911】Re:リストボックスを活用するには
お礼  にしもり  - 08/5/23(金) 10:54 -

引用なし
パスワード
   ▼カウボーイズ さん:
ありがとうございます。
おっしゃるとおりリスト数を代入したいのでListCountと加筆しました。
そうしたらエラーMsgはでなくなりました。

しかしその代わりに、実行してもウンともスンともいわなくなってしまいました。
なぜなのかわかりません。
できるがぎり自力で調べてみます。

(標準モジュール)

Option Explicit

Public i As Long
Public ws1 As Worksheet
Public MyCount As Integer
Public n As Long

Sub Sample()

With UserForm1.ListBox1

MyCount = UserForm1.ListBox1.ListCount - 1 '←リスト数を代入したいのでListCountと加筆しました。
  For n = 0 To MyCount
    If (.Selected(n) = True) Then
      If Not Application.Intersect(Range("C3:C104"), ActiveCell) Is Nothing Then
       Set ws1 = Worksheets("history")
       i = ws1.Range("B65536").End(xlUp).Row + 1
         If i < 5 Then
          i = 5
         End If
    
          With ActiveCell
           ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
           ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
          End With
    
    
         UserForm1.Show
      Else
         MsgBox "Programのいずれかを選択してください。"
      End If
    End If
  Next n
End With
End Sub

-----------------------------------------------------

(ユーザーーフォーム)
Option Explicit

Private Sub UserForm_Initialize()
  Calendar1.Value = Date
'  カレンダーの日付をセルにセットする
   Dim i As Integer

  Me.ListBox1.RowSource = Worksheets("member").Range("a2:a51").Address(external:=True) 

    Me.TextBox1.Value = Date
    With Me.ComboBox1
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox2
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
    With Me.ComboBox3
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox4
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
'  カレンダーの日付をセルにセットする
End Sub

Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double

 If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
  From_Str = Me.ComboBox1.Value & ":" & Me.ComboBox2.Value
 End If
 If Me.ComboBox3.Value <> "" And Me.ComboBox4.Value <> "" Then
  To_Str = Me.ComboBox3.Value & ":" & Me.ComboBox4.Value
 End If
 If From_Str <> "" And To_Str <> "" Then
  Hours = (CDate(To_Str) - CDate(From_Str)) * 24
  'Date
  ws1.Cells(i, 5).Value = Me.TextBox1.Value
  'Time(From)
  ws1.Cells(i, 6).Value = CDate(From_Str)
  'Time(To)
  ws1.Cells(i, 7).Value = CDate(To_Str)
  'Hours
  ws1.Cells(i, 8).Value = (CDate(To_Str) - CDate(From_Str)) * 24
  'Place
  ws1.Cells(i, 10).Value = Me.TextBox2.Value
  'Notese
  ws1.Cells(i, 11).Value = Me.TextBox3.Value
 End If
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub

【55912】Re:リストボックスを活用するには
回答  カウボーイズ  - 08/5/23(金) 11:44 -

引用なし
パスワード
   MyCount = UserForm1.ListBox1.ListCount - 1
  For n = 0 To MyCount
    If (.Selected(n) = True) Then
↑この段階でユーザーフォームって開かれてます?
閉じてる状態だと何も選択されていないから、この条件ではずっと偽になりますよね?

ローカルウィンドウのデバッグで、ステップインを実行してよく動作を確認してみてはどうでしょう?

【55968】Re:リストボックスを活用するには
質問  にしもり  - 08/5/26(月) 17:10 -

引用なし
パスワード
   ▼カウボーイズ さん:
ご指摘にありがとうございます。

条件を整理し、
1.UserFomrははじめからひらいている必要ある
2.Userformのボタンclickイベントで諸項目の代入がはじまる
ことが判ったので以下のようにロジック変えました。
おおきな一歩であります。

また、最終ゴールにむけ以下の条件を追加しました。
3.リストボックスで選択された名前と社員番号を、それぞれ(a2:a51)と(b2:b51)からws1に代入
4.リストボックスで複数選択されてる場合は、Mycount=nになるまでループして代入
でもうんともすんともいいません。どこが悪いかどなたかご教示くださいませんか。

ListboxのプロパティのColumnCountは2にしてあります。


(標準モジュール)

Sub Sample()
 UserForm1.Show
End Sub
---------------------------------------------
(ユーザーフォーム)

Option Explicit

Public i As Long
Public ws1 As Worksheet
Public MyCount As Integer
Public n As Long


Private Sub UserForm_Initialize()
  Calendar1.Value = Date
'  カレンダーの日付をセルにセットする
  Dim i As Integer

  Me.ListBox1.RowSource = Worksheets("member").Range("a2:b51").Address(external:=True)
  
  Me.TextBox1.Value = Date
  With Me.ComboBox1
   For i = 1 To 24
    .AddItem i
   Next
  End With

  With Me.ComboBox2
   For i = 0 To 45 Step 15
    .AddItem i
   Next
  End With
  With Me.ComboBox3
   For i = 1 To 24
    .AddItem i
   Next
  End With
  With Me.ComboBox4
   For i = 0 To 45 Step 15
    .AddItem i
   Next
  End With
  
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
'  カレンダーの日付をセルにセットする
End Sub

Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double

If Not Application.Intersect(Range("C3:C104"), ActiveCell) Is Nothing Then
Else
  MsgBox "Programのいずれかを選択してください。"
End If

  With UserForm1.ListBox1
   
    MyCount = Me.ListBox1.ListCount - 1
    For n = 0 To MyCount
      If (Me.ListBox1.Selected(n) = True) Then
       
        With ListBox1
        If (.ListIndex = -1) Then
       
         Set ws1 = Worksheets("history")
         i = ws1.Range("B65536").End(xlUp).Row + 1
           If i < 5 Then
            i = 5
           End If
      
            With ActiveCell
             ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
             ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
             
              If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
              From_Str = Me.ComboBox1.Value & ":" & Me.ComboBox2.Value
              End If
              If Me.ComboBox3.Value <> "" And Me.ComboBox4.Value <> "" Then
              To_Str = Me.ComboBox3.Value & ":" & Me.ComboBox4.Value
              End If
             
              If From_Str <> "" And To_Str <> "" Then
              Hours = (CDate(To_Str) - CDate(From_Str)) * 24
              'Date
              ws1.Cells(i, 5).Value = Me.TextBox1.Value
              'Time(From)
              ws1.Cells(i, 6).Value = CDate(From_Str)
              'Time(To)
              ws1.Cells(i, 7).Value = CDate(To_Str)
              'Hours
              ws1.Cells(i, 8).Value = (CDate(To_Str) - CDate(From_Str)) * 24
              'Place
              ws1.Cells(i, 10).Value = Me.TextBox2.Value
              'Notes
              ws1.Cells(i, 11).Value = Me.TextBox3.Value
              '社員番号 (社員番号が左)
               ws1.Cells(i, 12).Value = Me.ListBox1.TextColumn = 2
              '名前 (名前が右)
               ws1.Cells(i, 13).Value = Me.ListBox1.TextColumn = 1


              End If
            End With
          End If
        End With
      End If
    Next n
  End With
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub

【55973】Re:リストボックスを活用するには
質問  にしもり  - 08/5/27(火) 16:08 -

引用なし
パスワード
   自己レスです。

If (.ListIndex = -1) Then
Else '←ここにElseをいれたら動くには動きました。

ただ、後半の
ws1.Cells(i, 12).Value = Me.ListBox1.TextColumn = 2
ws1.Cells(i, 13).Value = Me.ListBox1.TextColumn = 1
がいずれもFALSEになってしまいます。

-----------------------------------------------

ついては、かいつまんでお聞きしたいのですが、
    
  With ListBox1
    If (.ListIndex = -1) Then
    Else
     Set ws1 = Worksheets("history")
     i = ws1.Range("B65536").End(xlUp).Row + 1
       If i < 5 Then
        i = 5
       End If
     With ActiveCell
       ws1.Cells(i, 12).Value = Me.ListBox1.TextColumn = 2
       ws1.Cells(i, 13).Value = Me.ListBox1.TextColumn = 1
     End With
    End If
  End With
    

このとき ws1.Cells(i, 12)および ws1.Cells(i, 13)に
リストボックスで選択した行が入らず、FALSEと入ってしまうのはどこがいけないからでしょうか。

【55974】Re:リストボックスを活用するには
発言  Yuki  - 08/5/27(火) 16:18 -

引用なし
パスワード
   ▼にしもり さん:
>
>ただ、後半の
>ws1.Cells(i, 12).Value = Me.ListBox1.TextColumn = 2
>ws1.Cells(i, 13).Value = Me.ListBox1.TextColumn = 1
この書き方はチョットまずいのでは

ws1.Cells(i, 12).Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
ws1.Cells(i, 13).Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
でどうでしょう。

【55975】Re:リストボックスを活用するには
お礼  にしもり  - 08/5/27(火) 16:28 -

引用なし
パスワード
   ▼Yuki さん:
ありがとうございます!
一日中、教本を読んでもできなかったのがYukiさんのひとことでできした。

Listプロパティというものがあるのですね。
引数であるColomnにあたる箇所に(Me.ListBox1.ListIndex, x)と書くのですね。
そういう基本的なことが分かっておりません。

【55976】Re:リストボックスを活用するには
質問  にしもり  - 08/5/27(火) 17:38 -

引用なし
パスワード
   実行結果をよくみましたらまだ完成ではありませんでした。

リストボックスのMultiSelectプロパティでfmMultiSelectExtendedにしているのですが、
たとえばリストボックスで
Yamada_Hanako
Yamada_Taro
を選んんでもシートには
Yamada_Taro
Yamada_Taro
と転記されてしまします。

そこでこのような記述は出来ないでしょうか。
↓↓
ws1.Cells(i, 12).Value = Me.ListBox1.List(Me.ListBox1.Selected(n), 1)
ws1.Cells(i, 13).Value = Me.ListBox1.List(Me.ListBox1.Selected(n), 0)
つまりForステートメントがMycountに達するまでの間に
n=1のときはYamada_Hanakoと書き出し
n=2のときはYamada_Taroと書き出したいのです。

ご教示よろしくお願いいたします。

【55978】Re:リストボックスを活用するには
回答  カウボーイズ  - 08/5/27(火) 22:25 -

引用なし
パスワード
   こんばんは
私の解釈が合ってるかちょっと自信ないですが、こういう事がしたいのでしょうか?

For n = 0 to MyCount   ' ←リストボックスの全リストを検査
  If Me.ListBox1.Selected(n) = True Then
    ' リスト番号 n が選択されているならそこからデータ抽出する
    ws1.Cells(i, 12) = Me.ListBox1.List(n, 1)
    ws1.Cells(i, 13) = Me.ListBox1.List(n, 0)
  End If
  i = i + 1  ' ←iを他の場所でずらしているならこれは必要ないです
Next n

【55979】Re:リストボックスを活用するには
回答  カウボーイズ  - 08/5/28(水) 0:01 -

引用なし
パスワード
   一度返信しましたが、ちょっと全体見て書き直してみます
あくまで私自身が見て、無駄だと思われる部分を修正してみますので必要に応じてご自分でカスタマイズしてください
※かなり長文になってしまいました すいません

とりあえず前回返信した【55978】の内容でやってみて成功したら、以下を読んでみてください。【55978】でエラーが出てたら意味が無いので・・・

↓このプロシージャからです
Private Sub CommandButton1_Click()
宣言等は割愛します

'With UserForm1.ListBox1
↑この下のコードでWith の意味がほとんど無いのでこの文を削除

'MyCount = Me.ListBox1.ListCount - 1
↑これも意味が無いと思うので削除
For文を書き換えます

For n = 0 To Me.ListBox1.ListCount - 1  ' ←ここ変えてます
  If (Me.ListBox1.Selected(n) = True) Then

  'With ListBox1
  'If (.ListIndex = -1) Then
  ↑この2行もいらないはずです(それに付随する Else もいらない)

   Set ws1 = Worksheets("history")
    i = ws1.Range("B65536").End(xlUp).Row + 1
    If i < 5 Then
     i = 5
    End If
   ↑この5行はループ内で毎回行われる必要が無いので、ループの外に出してみましょう

  次の
  With ActiveCell
  から
  ws1.Cells(i, 11).Value = Me.TextBox3.Value
  までは多分OK(元データが分からないので・・・)

  '社員番号 (社員番号が左)
  'ws1.Cells(i, 12).Value = Me.ListBox1.TextColumn = 2
  '名前 (名前が右)
  'ws1.Cells(i, 13).Value = Me.ListBox1.TextColumn = 1
  ↑これを
  ws1.Cells(i, 12) = Me.ListBox1.List(n,1)
  ws1.Cells(i, 13) = Me.ListBox1.List(n,0)
  に直す


*** まとめると
Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double

If Not Application.Intersect(Range("C3:C104"), ActiveCell) Is Nothing Then
  '↑これもなんだか直した方がいい気がするけど・・・ 一応このままで
Else
  MsgBox "Programのいずれかを選択してください。"
  'ここは Exit Sub は入れなくていいのかな?
End If

Set ws1 = Worksheets("history")
i = ws1.Range("B" & Rows.Count).End(xlUp).Row + 1
If i < 5 Then
 i = 5
End If

For n = 0 To Me.ListBox1.ListCount - 1
 If (Me.ListBox1.Selected(n) = True) Then
   With ActiveCell
   から
   ws1.Cells(i, 11).Value = Me.TextBox3.Value  
   まではそのままで
  
    ws1.Cells(i, 12) = Me.ListBox1.List(n,1)
    ws1.Cells(i, 13) = Me.ListBox1.List(n,0)

    i = i + 1

    'ここにひとつ End If が入るのかな?
    End If
   End With
 End If
Next n

Unload UserForm1

End Sub

【55983】Re:リストボックスを活用するには
お礼  にしもり  - 08/5/28(水) 11:12 -

引用なし
パスワード
   ▼カウボーイズ さん:
ご返信まことにありがとうございます。
私は初級者なのにあれこれやりたくなるたちで、皆さまにいろいろご面倒をおかけしています。
目標は自力解決ですが道のりは遠いです。

さて【55978】にしたがい修正してみました所、成功しました。
次に、アドバイスに従って無駄な部分を修正しました。
下記部分については、シートに設けられたボタンを押してユーザーフォームをShowさせるときのプロシージャに移動しました。
If Not Application.Intersect(Range("C3:C104"), ActiveCell) Is Nothing Then
  UserForm1.Show
Else
  MsgBox "Programのいずれかを選択してください。"
End If

全体の実行結果はOKでした。
記述も大変スリムになりました。
このたびは本当にありがとうございました。
深く感謝申し上げます。

(標準モジュール)

Sub Sample()

  If Not Application.Intersect(Range("C3:C104"), ActiveCell) Is Nothing Then
    UserForm1.Show
  Else
    MsgBox "Programのいずれかを選択してください。"
  End If

End Sub

-------------------------------------------------
(ユーザーフォーム)

Option Explicit

Public i As Long
Public ws1 As Worksheet
Public MyCount As Integer
Public n As Long

Private Sub UserForm_Initialize()
  Calendar1.Value = Date
'  カレンダーの日付をセルにセットする
  Dim i As Integer

  Me.ListBox1.RowSource = Worksheets("member").Range("a2:b51").Address(external:=True)
  
  Me.TextBox1.Value = Date
  With Me.ComboBox1
   For i = 1 To 24
    .AddItem i
   Next
  End With
'
'  With Me.ComboBox2
'   For i = 0 To 45 Step 15
'    .AddItem i
'   Next
'  End With
'  With Me.ComboBox3
'   For i = 1 To 24
'    .AddItem i
'   Next
'  End With
'  With Me.ComboBox4
'   For i = 0 To 45 Step 15
'    .AddItem i
'   Next
'  End With
  
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
'  カレンダーの日付をセルにセットする
End Sub

Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double

    Set ws1 = Worksheets("history")
    i = ws1.Range("B65536").End(xlUp).Row + 1
    If i < 5 Then
      i = 5
    End If
           
    For n = 0 To Me.ListBox1.ListCount - 1
        If (Me.ListBox1.Selected(n) = True) Then

        With ActiveCell
          ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
          ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
'
'          If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
'          From_Str = Me.ComboBox1.Value & ":" & Me.ComboBox2.Value
'          End If
'          If Me.ComboBox3.Value <> "" And Me.ComboBox4.Value <> "" Then
'          To_Str = Me.ComboBox3.Value & ":" & Me.ComboBox4.Value
'          End If
'
'          If From_Str <> "" And To_Str <> "" Then
'          Hours = (CDate(To_Str) - CDate(From_Str)) * 24
'          'Date
'          ws1.Cells(i, 5).Value = Me.TextBox1.Value
'          'Time(From)
'          ws1.Cells(i, 6).Value = CDate(From_Str)
'          'Time(To)
'          ws1.Cells(i, 7).Value = CDate(To_Str)
'          'Hours
'          ws1.Cells(i, 8).Value = (CDate(To_Str) - CDate(From_Str)) * 24
'          'Place
'          ws1.Cells(i, 10).Value = Me.TextBox2.Value
'          'Notes
'          ws1.Cells(i, 11).Value = Me.TextBox3.Value
          'Id
          ws1.Cells(i, 12).Value = Me.ListBox1.List(n, 1)
          'Name
          ws1.Cells(i, 13).Value = Me.ListBox1.List(n, 0)
        
          i = i + 1
        
'          End If
        End With
      End If
    Next n
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub

4554 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free