[已解决]B列可多选下拉菜单，C列选项值相加

cunfu2010 · 发表于 2016-12-6 19:43

如题，想实现：
1、sheet1工作表B列制作可多选的下拉菜单（不用复选框），在B列单元格中的下拉菜单中点选某项则在单元格中同时输入选项内容，与之同行的C列单元格值为B列单元格中多个选项对应值的和，如果不点选则单元格保留原有内容或清空(清空B列单元格内容时，同行C列单元格内容同步清空)
2、下拉菜单中的内容是动态的，即随sheet2表中的内容变化而变化
求助，谢谢！

最佳答案

月排行榜 / 总排行榜

苏子龙

2016-12-7 11:18

本帖最后由苏子龙于 2016-12-7 11:44 编辑

cunfu2010 发表于 2016-12-7 10:39
谢谢，如果不用复选框，如何实现鼠标点击即输入

Private Sub ListBox1_Change()
If ListBox1.ListIndex = -1 Then Exit Sub
Dim i&, s$, he
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
s = s & "、" & .List(i)
he = he + arr(i + 1, 2)
End If
Next
ActiveCell.Value = Mid(s, 2)
ActiveCell.Offset(0, 1).Value = he
.Visible = False '加上这句就好了
End With
End Sub

复制代码

跳转到最佳答案楼层

苏子龙 · 发表于 2016-12-7 08:16

Dim arr
Private Sub ListBox1_Change()
If ListBox1.ListIndex = -1 Then Exit Sub
Dim i&, s$, he
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
s = s & "、" & .List(i)
he = he + arr(i + 1, 2)
End If
Next
ActiveCell.Value = Mid(s, 2)
ActiveCell.Offset(0, 1).Value = he
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal T As Range)
If T.Count > 1 Or T.Row < 2 Or T.Column <> 2 Then
ListBox1.Visible = False
Range("b:b").Interior.ColorIndex = 0
Exit Sub
End If
arr = Sheet2.Range("a2:b" & Sheet2.[a65536].End(3).Row)
Range("b:b").Interior.ColorIndex = 0
T.Interior.ColorIndex = 6
With ListBox1
.Clear
.MultiSelect = 1
.ListStyle = 1
.List = Application.Index(arr, , 1)
.Top = T.Top
.Left = T.Offset(, 1).Left
.Height = T.Height * 6
.Width = T.Width + 20
.Visible = True
End With
End Sub

复制代码

cunfu2010 · 发表于 2016-12-7 10:39

苏子龙发表于 2016-12-7 08:16

谢谢，如果不用复选框，如何实现鼠标点击即输入

苏子龙 · 发表于 2016-12-7 11:18

本帖最后由苏子龙于 2016-12-7 11:44 编辑

cunfu2010 发表于 2016-12-7 10:39
谢谢，如果不用复选框，如何实现鼠标点击即输入

Private Sub ListBox1_Change()
If ListBox1.ListIndex = -1 Then Exit Sub
Dim i&, s$, he
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
s = s & "、" & .List(i)
he = he + arr(i + 1, 2)
End If
Next
ActiveCell.Value = Mid(s, 2)
ActiveCell.Offset(0, 1).Value = he
.Visible = False '加上这句就好了
End With
End Sub

复制代码

cunfu2010 · 发表于 2016-12-7 11:59

苏子龙发表于 2016-12-7 11:18

谢谢。

cunfu2010 · 发表于 2016-12-8 15:29

苏子龙发表于 2016-12-7 11:18

你好，这个附件中单元格最后都有一个空白行（因 vbCrLf造成的），如何把最后的空白行删掉，即只保留内容不要空白行

苏子龙 · 发表于 2016-12-8 15:46

cunfu2010 发表于 2016-12-8 15:29
你好，这个附件中单元格最后都有一个空白行（因 vbCrLf造成的），如何把最后的空白行删掉，即只保留内容 ...

Private Sub ListBox1_Change()
If ListBox1.ListIndex = -1 Then Exit Sub
Dim i&, aa$, bb$
With ListBox1
For i = 0 To ListBox1.ListCount - 1
      If ListBox1.Selected(i) Then
         aa = aa & ListBox1.List(i) & vbCrLf
         If col = 2 Then
            bb = bb & d(ListBox1.List(i)) & vbCrLf
         Else
            bb = bb & d1(ListBox1.List(i)) & vbCrLf
         End If
      End If
Next
ActiveCell.Value = Mid(aa, 1, InStrRev(aa, vbCrLf) - 1)
ActiveCell.Offset(0, 1) = Mid(bb, 1, InStrRev(bb, vbCrLf) - 1)
Me.ListBox1.Visible = True
End With
End Sub

cunfu2010 · 发表于 2016-12-8 16:13

苏子龙发表于 2016-12-8 15:46
Private Sub ListBox1_Change()
If ListBox1.ListIndex = -1 Then Exit Sub
Dim i&, aa$, bb$

谢谢！！！！

cunfu2010 · 发表于 2016-12-8 20:11

苏子龙发表于 2016-12-8 15:46
Private Sub ListBox1_Change()
If ListBox1.ListIndex = -1 Then Exit Sub
Dim i&, aa$, bb$

你好，这是我学做了另外一种下拉菜单多选，问题：1、如果单元格中有奇数个选项，其中有一个是“北京”，单击单元格时会先自动删除“北京”，而有偶数个选项时则没有这个问题；

2、如果单元格中的选项内容为奇数个时，单击单元格时会先自动添加“北京”，内容为为偶数个时则没有这个问题。
我想应该用w MOD 2进行判断，但我写不出来了，麻烦指点一下，谢谢！

苏子龙 · 发表于 2016-12-9 07:45

cunfu2010 发表于 2016-12-8 20:11
你好，这是我学做了另外一种下拉菜单多选，问题：1、如果单元格中有奇数个选项，其中有一个是“北京”， ...

不知道你说的是什么意思，如果判断输入要奇偶，那么在change加个判断，个人水平有限可能帮不了你，希望楼主另开帖说明要求，说清要做的具体内容，我想其他大神一定会回答的。

		自动登录	找回密码
密码			注册

[已解决]B列可多选下拉菜单，C列选项值相加

评分

评分