[已解决]请哪位老师帮忙将列表框的内容保存到工作表中谢谢！

蒋德宏

列表框的问题.rar (15.47 KB, 下载次数: 19)

2013-6-2 12:36 上传

点击文件名下载附件 请哪位老师帮我写一段代码，将列表框中的内容保存到工作表中。谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-2 13:06

确定按钮的代码有BUG。
最好是要求所有数据录入完整后才能添加到列表框中。

1. Private Sub 确定_Click()
   
2. '列表框.RowSource = "sheet1!A1:G1"
   
3.     Dim i As Byte
   
4.     Dim arr
   
5.     With Me.列表框
   
6.         If Len(编码输入.Text) = 0 Or Len(小号.Text) = 0 Or Len(中号.Text) = 0 Or Len(大号.Text) = 0 Or Len(单价.Text) = 0 Or Len(营业员.Text) = 0 Then
   
7.             MsgBox "数据录入不完全"
   
8.             Exit Sub
   
9.         End If
   
10.         .AddItem
    
11.         arr = Array(编码输入.Text, 小号.Text, 中号.Text, 大号.Text, 单价.Text, 营业员.Text)
    
12.         For i = LBound(arr) To UBound(arr)
    
13.             .List(.ListCount - 1, i) = arr(i)
    
14.         Next
    
15.     End With
    
16.     编码输入.Text = ""
    
17.     小号.Text = ""
    
18.     中号.Text = ""
    
19.     大号.Text = ""
    
20.     单价.Text = ""
    
21.     营业员.Text = ""
    
22. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

添加到列表，写入到工作表时，都会根据ID号进行判断，存在的累加

关于列表框的问题.rar (28.84 KB, 下载次数: 3)

2013-6-2 15:56 上传

点击文件名下载附件

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr
   
3.     With Me.列表框
   
4.         If .ListCount > 0 Then
   
5.             Application.ScreenUpdating = False
   
6.             Application.DisplayAlerts = False
   
7.             Application.EnableEvents = False
   
8.             arr = Me.列表框.List
   
9.             Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(.ListCount, UBound(arr, 2) + 1).Value = arr
   
10.         Else
    
11.             MsgBox "列表框中无数据"
    
12.             Exit Sub
    
13.         End If
    
14.     End With
    
15.     Application.ScreenUpdating = True
    
16.     Application.DisplayAlerts = True
    
17.     Application.EnableEvents = True
    
18.     MsgBox "保存成功"
    
19. End Sub

复制代码

hwc2ycy

A列日期代码里没有填。

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr
   
3.     Dim lLastRow As Long
   
4.     With Me.列表框
   
5.         If .ListCount > 0 Then
   
6.             Application.ScreenUpdating = False
   
7.             Application.DisplayAlerts = False
   
8.             Application.EnableEvents = False
   
9.             arr = Me.列表框.List
   
10.             lLastRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
    
11.             Cells(lLastRow, 2).Resize(.ListCount, UBound(arr, 2) + 1).Value = arr
    
12.             Cells(lLastRow, 1).Value = Format(Date, "yyyy/m/d")
    
13.             If .ListCount > 1 Then
    
14.                 Cells(lLastRow, 1).AutoFill Cells(lLastRow, 1).Resize(.ListCount)
    
15.             End If
    
16.         Else
    
17.             MsgBox "列表框中无数据"
    
18.             Exit Sub
    
19.         End If
    
20.     End With
    
21.     Application.ScreenUpdating = True
    
22.     Application.DisplayAlerts = True
    
23.     Application.EnableEvents = True
    
24.     MsgBox "保存成功"
    
25. End Sub

复制代码

hwc2ycy

日期列用自动填充时，结果不对。

1. Private Sub CommandButton1_Click()
   
2.     Dim arr
   
3.     Dim lLastRow As Long
   
4.     With Me.列表框
   
5.         If .ListCount > 0 Then
   
6.             Application.ScreenUpdating = False
   
7.             Application.DisplayAlerts = False
   
8.             Application.EnableEvents = False
   
9.             arr = Me.列表框.List
   
10.             lLastRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
    
11.             Cells(lLastRow, 2).Resize(.ListCount, UBound(arr, 2) + 1).Value = arr
    
12.             Cells(lLastRow, 1).Resize(.ListCount).Value = Format(Date, "yyyy/m/d")
    
13.         Else
    
14.             MsgBox "列表框中无数据"
    
15.             Exit Sub
    
16.         End If
    
17.     End With
    
18.     Application.ScreenUpdating = True
    
19.     Application.DisplayAlerts = True
    
20.     Application.EnableEvents = True
    
21.     MsgBox "保存成功"
    
22. End Sub

复制代码

hwc2ycy

确定按钮的代码有BUG。
最好是要求所有数据录入完整后才能添加到列表框中。

1. Private Sub 确定_Click()
   
2. '列表框.RowSource = "sheet1!A1:G1"
   
3.     Dim i As Byte
   
4.     Dim arr
   
5.     With Me.列表框
   
6.         If Len(编码输入.Text) = 0 Or Len(小号.Text) = 0 Or Len(中号.Text) = 0 Or Len(大号.Text) = 0 Or Len(单价.Text) = 0 Or Len(营业员.Text) = 0 Then
   
7.             MsgBox "数据录入不完全"
   
8.             Exit Sub
   
9.         End If
   
10.         .AddItem
    
11.         arr = Array(编码输入.Text, 小号.Text, 中号.Text, 大号.Text, 单价.Text, 营业员.Text)
    
12.         For i = LBound(arr) To UBound(arr)
    
13.             .List(.ListCount - 1, i) = arr(i)
    
14.         Next
    
15.     End With
    
16.     编码输入.Text = ""
    
17.     小号.Text = ""
    
18.     中号.Text = ""
    
19.     大号.Text = ""
    
20.     单价.Text = ""
    
21.     营业员.Text = ""
    
22. End Sub

复制代码

hwc2ycy

关于列表框的问题.rar (25.1 KB, 下载次数: 24)

2013-6-2 13:08 上传

点击文件名下载附件

蒋德宏

hwc2ycy 发表于 2013-6-2 13:06
确定按钮的代码有BUG。
最好是要求所有数据录入完整后才能添加到列表框中。

老师您好：您帮我编写的代码是我见过的最简洁的代码了，您能帮我再把如果新录入的编号跟工作表里面的编号是一样的话，就让小号、中号、大号、跟单价自动累加到工作表里面同样编号里面吗？麻烦您了！

hwc2ycy

蒋德宏 发表于 2013-6-2 13:38
老师您好：您帮我编写的代码是我见过的最简洁的代码了，您能帮我再把如果新录入的编号跟工作表里面的编号 ...

这个可以直接另外再写个过程嘛。