请高手帮忙修改代码

alonzhang76

见附件，工作表 ”报价录入“ 中 ”查询” 按钮跳出的窗体，请高手帮忙修改代码实现：


1. 需要在合同列表LISTBOX1中选择一行后，则在下面LISTBOX2中只显示该合同项下明细（现在显示的是所有合同号项下的明细）；
2. 将LISTBOX1和LISTBOX2各列自适应列宽；
3. 两个LISTBOX中金额显示为带小数点格式，如10000显示为10,000.00
4. 用代码使工作表”报价录入“的A21:M100区域单元格缩小字体填充

3190496160

1、很多个窗体，究竟说的是哪一个窗体的问题？
2、要自适应列宽，就用viewlist控件吧

alonzhang76

3190496160 发表于 2022-12-14 21:23
1、很多个窗体，究竟说的是哪一个窗体的问题？
2、要自适应列宽，就用viewlist控件吧

见附件截图所示

alonzhang76

3190496160 发表于 2022-12-14 21:23
1、很多个窗体，究竟说的是哪一个窗体的问题？
2、要自适应列宽，就用viewlist控件吧

关于另外第2，3，4问题，若实在麻烦实现就算了，最关键需要的就是解决第1个问题，有劳了，感谢

3190496160

Private Sub listbox1_Change()
Application.ScreenUpdating = False
Dim ar As Variant
With Sheets("报价明细")
     r = .Cells(Rows.Count, 1).End(xlUp).Row
     ar = .Range("a1:m" & r)
End With
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        mc = ListBox1.List(i, 2)
        Exit For
    End If
Next i
If mc = "" Then Exit Sub
Dim arr()
ReDim arr(1 To UBound(ar), 1 To UBound(ar, 2))
n = 1
For j = 1 To UBound(ar, 2)
    arr(n, j) = ar(1, j)
Next j
For i = 2 To UBound(ar)
    If Trim(ar(i, 3)) = Trim(mc) Then
        n = n + 1
        For j = 1 To UBound(ar, 2)
            arr(n, j) = ar(i, j)
        Next j
    End If
Next i
If n = "" Then Exit Sub
With ListBox2
    .Clear
    .ColumnCount = 13
    .List = arr
End With
Application.ScreenUpdating = True
End Sub

3190496160

报价单.rar (249.8 KB, 下载次数: 8)

2022-12-14 22:29 上传

点击文件名下载附件

3190496160

一个很简单的问题，硬是被你搞的如此复杂。
目前的代码，基本上都是在循环单元格，而且，很多无用的过程，如果数据量稍大，代码运行的速度就是一个大问题，

alonzhang76

3190496160 发表于 2022-12-14 22:29

太厉害了，感谢老师，工作表“报价录入”的A21:M100区域有什么办法缩小字体填充，我用cells.shrinktofit怎么试都不行，可能代码放的位置不对

洋务德雷

解决了两个问题。第一个和第三个问题。

alonzhang76

3190496160 发表于 2022-12-14 22:30
一个很简单的问题，硬是被你搞的如此复杂。
目前的代码，基本上都是在循环单元格，而且，很多无用的过程， ...

是的，刚学VBA不久，非常感谢，我得好好学习一下你的思路