ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: 弓长。亻韦

[求助] VBA窗体查询,来个超级大神帮忙解决的

[复制链接]

TA的精华主题

TA的得分主题

发表于 2022-3-14 08:08 | 显示全部楼层
弓长。亻韦 发表于 2022-3-13 23:12
给你看下我的新作,,,,还请大神帮忙点睛啊,,,(一指禅大神)

向您学习!Excel二次开发本来就是见仁见智,满足自己需求的就是最好的。随着自己VBA知识积累,不断完善她,日臻优美!

TA的精华主题

TA的得分主题

 楼主| 发表于 2022-3-14 10:34 | 显示全部楼层
一指禅62 发表于 2022-3-14 08:08
向您学习!Excel二次开发本来就是见仁见智,满足自己需求的就是最好的。随着自己VBA知识积累,不断完善她 ...

我昨晚在做的新的看了吗。。。还希望大神帮帮忙啊

TA的精华主题

TA的得分主题

 楼主| 发表于 2022-3-14 11:34 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
一指禅62 发表于 2022-3-14 08:08
向您学习!Excel二次开发本来就是见仁见智,满足自己需求的就是最好的。随着自己VBA知识积累,不断完善她 ...


一直出错哪里不对了啊 大神


Option Explicit
Option Base 1

Dim da, i&, j%, d As Object, d1 As Object, d2 As Object, d3 As Object
Dim m&, n&, S$, k, t, x%

Private Sub UserForm_Initialize()
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    Set d3 = CreateObject("scripting.dictionary")
    Call MultiPage1_Change
End Sub
Private Sub 后道查询_Click()
    Dim m3 As Long, m4 As Long  '发出/交回
    t = Split(d2.Item(后道款式.Text), "|")
    ReDim temp(UBound(t) + 2, UBound(da, 2))
    For j = 1 To UBound(da, 2)
        temp(1, j) = da(2, j)
    Next
    For i = 0 To UBound(t)
        x = t(i)
        If da(x, 8) = "发出" Then
            m3 = m3 + da(x, 5)
        End If
        If da(x, 8) = "交回" Then
            m4 = m4 + da(x, 5)
        End If
        For j = 1 To UBound(da, 2)
            temp(i + 2, j) = da(x, j)
        Next
    Next
    ListBox5.List = temp
    ListBox5.ColumnCount = UBound(da, 2)
    TextBox44.Text = m3
    TextBox45.Text = m4
    TextBox46.Text = m3 - m4
End Sub
Private Sub 后道姓名_Change()
    On Error GoTo Err1
    d2.RemoveAll
    For Each t In Split(d.Item(后道姓名.Text), "|")
        S = Trim(da(t, 4)) '款式
        If Not d2.Exists(S) Then
            d2(S) = t
        Else
            d2(S) = d2(S) & "|" & t
        End If
    Next
    后道款式.List = d2.Keys
    后道款式.ListIndex = 0
    Exit Sub
Err1:
    MsgBox Err.Description, vbExclamation, "错误报告"
End Sub


Private Sub 套口姓名_Change()
    On Error GoTo Err1
    d1.RemoveAll
    For Each t In Split(d.Item(套口姓名.Text), "|")
        S = Trim(da(t, 4)) '款式
        If Not d1.Exists(S) Then
            d1(S) = t
        Else
            d1(S) = d1(S) & "|" & t
        End If
    Next
    套口款式.List = d1.Keys
    套口款式.ListIndex = 0
    Exit Sub
Err1:
    MsgBox Err.Description, vbExclamation, "错误报告"
End Sub
Private Sub MultiPage2_Change()
    On Error GoTo Err1
    n = 0: d.RemoveAll
    Select Case MultiPage1.SelectedItem.Caption
        Case Is = "后道查询"
            With Sheets("缩絨统计")
                i = .Range("B" & Rows.Count).End(3).Row
                da = .Range("A1:I" & i).Value
            End With
            For i = 3 To UBound(da)
                S = Trim(da(i, 3))  '姓名
                If Not d.Exists(S) Then
                    d3(S) = i
                Else
                    d3(S) = d3(S) & "|" & i
                End If
            Next
            后道姓名.List = d.Keys
            后道姓名.ListIndex = 0
        Case Is = ""
   
    End Select
    Exit Sub
Err1:
    MsgBox Err.Description, vbExclamation, "错误报告"
End Sub
Private Sub MultiPage1_Change()
    On Error GoTo Err1
    n = 0: d.RemoveAll
    Select Case MultiPage1.SelectedItem.Caption
        Case Is = "套口查询"
            With Sheets("套口统计")
                i = .Range("B" & Rows.Count).End(3).Row
                da = .Range("A1:K" & i).Value
            End With
            For i = 3 To UBound(da)
                S = Trim(da(i, 3))  '姓名
                If Not d.Exists(S) Then
                    d(S) = i
                Else
                    d(S) = d(S) & "|" & i
                End If
            Next
            套口姓名.List = d3.Keys
            套口姓名.ListIndex = 0
        Case Is = ""
   
    End Select
    Exit Sub
Err1:
    MsgBox Err.Description, vbExclamation, "错误报告"
End Sub
Private Sub 套口查询_Click()
    Dim m1 As Long, m2 As Long  '发出/交回
    Dim f1 As Long, f2 As Long  '返工
    Dim yy As Long              '样衣
    t = Split(d1.Item(套口款式.Text), "|")
    ReDim temp(UBound(t) + 2, UBound(da, 2))
    For j = 1 To UBound(da, 2)
        temp(1, j) = da(2, j)
    Next
    For i = 0 To UBound(t)
        x = t(i)
        If da(x, 10) = "发出" Then
            m1 = m1 + da(x, 5)
            f1 = f1 + da(x, 8)  '返工
        End If
        If da(x, 10) = "交回" Then
            m2 = m2 + da(x, 5)
            f2 = f2 + da(x, 8)  '返工
        End If
        yy = yy + da(x, 7)
        For j = 1 To UBound(da, 2)
            temp(i + 2, j) = da(x, j)
        Next
    Next
    ListBox4.List = temp
    ListBox4.ColumnCount = UBound(da, 2)
    TextBox37.Text = m1: TextBox38.Text = f1
    TextBox39.Text = m2: TextBox40.Text = f2
    TextBox41.Text = m1 - m2
    TextBox42.Text = f1 - f2
    TextBox43.Text = yy
End Sub



TA的精华主题

TA的得分主题

 楼主| 发表于 2022-3-14 13:54 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
一指禅62 发表于 2022-3-14 08:08
向您学习!Excel二次开发本来就是见仁见智,满足自己需求的就是最好的。随着自己VBA知识积累,不断完善她 ...

这样平车查询可以用,,,套口的就用不了,,出错。。哪里不对啊


Option Explicit
Option Base 1

Dim da, i&, j%, d As Object, d1 As Object
Dim m&, n&, S$, k, t, x%
Private Sub UserForm_Initialize()
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    Call MultiPage1_Change
End Sub

Private Sub 平车姓名_Change()
    On Error GoTo Err1
    d1.RemoveAll
    For Each t In Split(d.Item(平车姓名.Text), "|")
        S = Trim(da(t, 4)) '款式
        If Not d1.Exists(S) Then
            d1(S) = t
        Else
            d1(S) = d1(S) & "|" & t
        End If
    Next
    平车款式.List = d1.Keys
    平车款式.ListIndex = 0
    Exit Sub
Err1:
    MsgBox Err.Description, vbExclamation, "错误报告"
End Sub

Private Sub MultiPage1_Change()
    On Error GoTo Err1
    n = 0: d.RemoveAll
    Select Case MultiPage1.SelectedItem.Caption
        Case Is = "平车查询"
            With Sheets("平车统计")
                i = .Range("B" & Rows.Count).End(3).Row
                da = .Range("A1:K" & i).Value
            End With
            For i = 3 To UBound(da)
                S = Trim(da(i, 3))  '姓名
                If Not d.Exists(S) Then
                    d(S) = i
                Else
                    d(S) = d(S) & "|" & i
                End If
            Next
            平车姓名.List = d.Keys
            平车姓名.ListIndex = 0
        Case Is = ""
   
    End Select
    Exit Sub
Err1:
    MsgBox Err.Description, vbExclamation, "错误报告"
End Sub

Private Sub 平车查询_Click()
    Dim m1 As Long, m2 As Long  '发出/交回
    Dim f1 As Long, f2 As Long  '返工
    Dim yy As Long              '样衣
    t = Split(d1.Item(平车款式.Text), "|")
    ReDim temp(UBound(t) + 2, UBound(da, 2))
    For j = 1 To UBound(da, 2)
        temp(1, j) = da(2, j)
    Next
    For i = 0 To UBound(t)
        x = t(i)
        If da(x, 10) = "发出" Then
            m1 = m1 + da(x, 8)

        End If
        If da(x, 10) = "交回" Then
            m2 = m2 + da(x, 8)

        End If
        For j = 1 To UBound(da, 2)
            temp(i + 2, j) = da(x, j)
        Next
    Next
    ListBox6.List = temp
    ListBox6.ColumnCount = UBound(da, 2)
    TextBox47.Text = m1
    TextBox48.Text = m2
    TextBox49.Text = m1 - m2

End Sub
-----------------------------------------------------------------------------------------------------------------------
Private Sub 套口姓名_Change()
    On Error GoTo Err1
    d1.RemoveAll
    For Each t In Split(d.Item(套口姓名.Text), "|")
        S = Trim(da(t, 4)) '款式
        If Not d1.Exists(S) Then
            d1(S) = t
        Else
            d1(S) = d1(S) & "|" & t
        End If
    Next
    套口款式.List = d1.Keys
    套口款式.ListIndex = 0
    Exit Sub
Err1:
    MsgBox Err.Description, vbExclamation, "错误报告"
End Sub

Private Sub MultiPage2_Change()
    On Error GoTo Err1
    n = 0: d.RemoveAll
    Select Case MultiPage1.SelectedItem.Caption
        Case Is = "套口查询"
            With Sheets("套口统计")
                i = .Range("B" & Rows.Count).End(3).Row
                da = .Range("A1:K" & i).Value
            End With
            For i = 3 To UBound(da)
                S = Trim(da(i, 3))  '姓名
                If Not d.Exists(S) Then
                    d(S) = i
                Else
                    d(S) = d(S) & "|" & i
                End If
            Next
            套口姓名.List = d.Keys
            套口姓名.ListIndex = 0
        Case Is = ""
   
    End Select
    Exit Sub
Err1:
    MsgBox Err.Description, vbExclamation, "错误报告"
End Sub

Private Sub 套口查询_Click()
    Dim m1 As Long, m2 As Long  '发出/交回
    Dim f1 As Long, f2 As Long  '返工
    Dim yy As Long              '样衣
    t = Split(d1.Item(套口款式.Text), "|")
    ReDim temp(UBound(t) + 2, UBound(da, 2))
    For j = 1 To UBound(da, 2)
        temp(1, j) = da(2, j)
    Next
    For i = 0 To UBound(t)
        x = t(i)
        If da(x, 10) = "发出" Then
            m1 = m1 + da(x, 5)
            f1 = f1 + da(x, 8)  '返工
        End If
        If da(x, 10) = "交回" Then
            m2 = m2 + da(x, 5)
            f2 = f2 + da(x, 8)  '返工
        End If
        yy = yy + da(x, 7)
        For j = 1 To UBound(da, 2)
            temp(i + 2, j) = da(x, j)
        Next
    Next
    ListBox4.List = temp
    ListBox4.ColumnCount = UBound(da, 2)
    TextBox37.Text = m1: TextBox38.Text = f1
    TextBox39.Text = m2: TextBox40.Text = f2
    TextBox41.Text = m1 - m2
    TextBox42.Text = f1 - f2
    TextBox43.Text = yy
End Sub

TA的精华主题

TA的得分主题

发表于 2022-3-25 17:05 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-17 13:23 , Processed in 0.028919 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表