|
はじめまして。
最近VBAをはじめたのですがあるところで詰まりました。
どなたかご教授ください。。
リストボックスが二つあります。rirekiとSBとします。
rirekiにはSBで選択されたものが重複を許さず追加されていき、
重複が起きた場合は一旦削除して一番上に再び追加します。
また、rireki自身も選択可能で選択すると必然と重複が起きますので
一旦消して一番上に再び追加してます。
この両方の操作でsheet1のあるセルに選択したvalueを入れています。
rowsourceとしてsheet2のある列をそれぞれ使っています。
以下はコードなのですが詰まっているところは
rireki自身を選択したときにセルにうまく選択したものが入らず
ずれが生じ、また、2重に内容もrirekiに登録されてしまします。
よろしくお願いします。
以下useform1に記述
Private Sub rireki_Click()
Dim i As Long, flag As Boolean
If 行 >= 5 Then
Cells(行, 10) = rireki.Value
End If
i = 10
For i = 1 To 10
If rireki.Value = Worksheets("sheet2").Cells(i + 2, 12).Value Then
flag = True
Exit For
End If
Next i
Do While i > 1
Worksheets("sheet2").Cells(i + 2, 12).Value = Worksheets("sheet2").Cells(i + 1, 12).Value
i = i - 1
Loop
Worksheets("sheet2").Cells(3, 12).Value = rireki.Value
UserForm1.Hide
End Sub
Private Sub SB_Click()
Dim i As Long, flag As Boolean
If 行 >= 5 Then
Cells(行, 10) = SB.Value
End If
i = 10
For i = 1 To 10
If SB.Value = Worksheets("sheet2").Cells(i + 2, 12).Value Then
flag = True
Exit For
End If
Next i
If flag Then
Do While i > 1
Worksheets("sheet2").Cells(i + 2, 12).Value = Worksheets("sheet2").Cells(i + 1, 12).Value
i = i - 1
Loop
Worksheets("sheet2").Cells(3, 12).Value = SB.Value
End If
If Not flag Then
i = 10
Do While i > 1
Worksheets("sheet2").Cells(i + 2, 12).Value = Worksheets("sheet2").Cells(i + 1, 12).Value
i = i - 1
Loop
Worksheets("sheet2").Cells(3, 12).Value = SB.Value
End If
UserForm1.Hide
End Sub
Private Sub userform_deactive()
Unload Me
End Sub
以下worksheetに記述
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 10 And Target.Row >= 5 Then
Cancel = True
行 = Target.Row
列 = Target.Column
UserForm1.rireki.RowSource = ""
UserForm1.rireki.RowSource = "sheet2!l3:l12"
UserForm1.SB.RowSource = ""
UserForm1.SB.RowSource = "sheet2!j3:j50"
UserForm1.SG.RowSource = ""
UserForm1.SG.RowSource = "sheet2!k3:k50"
UserForm1.Show
End If
End Sub
以下module1
Option Explicit
Public 行 As Variant
Public 列 As Variant
Sub auto_open()
Load UserForm1
End Sub
|
|