[已解决]窗体求改进！

孤单无所谓

东西都在附件里，已有说明

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-1-16 11:14

孤单无所谓 发表于 2013-1-16 11:05
没弄明白怎么回事 代码原封没懂嘛！！！

没认真看嘛。
进销存系统.rar (38.38 KB, 下载次数: 14)

2013-1-16 11:14 上传

点击文件名下载附件

跳转到最佳答案楼层

hwc2ycy

你的现在可以直接双击进入表格中，不过不能多项同时进入。
另外关键字一栏，只能针对第一列。

孤单无所谓

hwc2ycy 发表于 2013-1-16 10:38
你的现在可以直接双击进入表格中，不过不能多项同时进入。
另外关键字一栏，只能针对第一列。

这个我知道。。。。能不能在双击第一列然后在弹出个窗体  输入箱数 最后在一起复制到 左表中啊？？

hwc2ycy

针对输入的箱数进行筛选

1. Private Sub TextBox1_Change()
   
2.     Dim what As String: what = TextBox1.value
   
3.     ListView1.ListItems.Clear
   
4.     If what = "" Then
   
5.         For i = 1 To UBound(arr)
   
6.             Set itm = ListView1.ListItems.Add()
   
7.             itm.Text = arr(i, 1)
   
8.             itm.SubItems(1) = arr(i, 2)
   
9.             itm.SubItems(2) = arr(i, 3)
   
10.             itm.SubItems(3) = arr(i, 4)
    
11.             itm.SubItems(4) = Format(arr(i, 5), "0.00")
    
12.         Next i
    
13.     Else
    
14.         Dim dic As Object
    
15.         Set dic = CreateObject("scripting.dictionary")
    
16.         For i = 1 To UBound(arr)
    
17.             If arr(i, 3) Like "*" & what & "*" Then
    
18.                 If Not dic.exists(arr(i, 1)) Then
    
19.                     dic.Add arr(i, 1), ""
    
20.                     Set itm = ListView1.ListItems.Add()
    
21.                     itm.Text = arr(i, 1)
    
22.                     itm.SubItems(1) = arr(i, 2)
    
23.                     itm.SubItems(2) = arr(i, 3)
    
24.                     itm.SubItems(3) = arr(i, 4)
    
25.                     itm.SubItems(4) = Format(arr(i, 5), "0.00")
    
26.                 End If
    
27.             End If
    
28.         Next
    
29.     End If
    
30.     Label2.Caption = "共找到 " & ListView1.ListItems.Count & " 条记录"
    
31.     Set dic = Nothing
    
32. End Sub

复制代码

hwc2ycy

回车后，筛选的数据写入表格

1. Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   
2.     If Len(TextBox1.Text) = 0 Then Exit Sub
   
3.     Dim i&, arr1, j&
   
4. 
   
5.     With Me.ListView1
   
6.         ReDim arr1(1 To .ListItems.Count, 1 To 5)
   
7.         For i = 1 To .ListItems.Count
   
8.             arr1(i, 1) = .ListItems(i).Text
   
9.             For j = 2 To UBound(arr, 2)
   
10.                 arr1(i, j) = .ListItems(1).SubItems(j - 1)
    
11.             Next
    
12.             arr1(i, 3) = ""
    
13.         Next
    
14.     End With
    
15.     Selection.Resize(UBound(arr1), UBound(arr1, 2)) = arr1
    
16. End Sub

复制代码

孤单无所谓

hwc2ycy 发表于 2013-1-16 10:53
针对输入的箱数进行筛选

没弄明白怎么回事 代码原封没懂嘛！！！

hwc2ycy

写入数据，我直接偷懒了，因为你在TEXTBOX回车后焦点就转移了，直接用的ONEXIT事件。
另外我觉得你写入数据的位置，其实直接用最后一行位置来比较好。

hwc2ycy

按A列空白位置依次写入表中。

1. 
   
2. Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   
3.     If Len(TextBox1.Text) = 0 Then Exit Sub
   
4.     Dim i&, arr1, j&
   
5. 
   
6.     With Me.ListView1
   
7.         ReDim arr1(1 To .ListItems.Count, 1 To 5)
   
8.         For i = 1 To .ListItems.Count
   
9.             arr1(i, 1) = .ListItems(i).Text
   
10.             For j = 2 To UBound(arr, 2)
    
11.                 arr1(i, j) = .ListItems(1).SubItems(j - 1)
    
12.             Next
    
13.             arr1(i, 3) = ""
    
14.         Next
    
15.     End With
    
16.     i = [a65536].End(xlUp).Row + 1
    
17.     Cells(i, 1).Resize(UBound(arr1), UBound(arr1, 2)) = arr
    
18.     'Selection.Resize(UBound(arr1), UBound(arr1, 2)) = arr1
    
19. End Sub
    

复制代码

hwc2ycy

孤单无所谓 发表于 2013-1-16 11:05
没弄明白怎么回事 代码原封没懂嘛！！！

没认真看嘛。
进销存系统.rar (38.38 KB, 下载次数: 14)

2013-1-16 11:14 上传

点击文件名下载附件

孤单无所谓

hwc2ycy 发表于 2013-1-16 11:06
写入数据，我直接偷懒了，因为你在TEXTBOX回车后焦点就转移了，直接用的ONEXIT事件。
另外我觉得你写入数据 ...

我已经晕了 能不能上个附件让我瞅瞅{:3912:}