VBA 自动编号 + 窗体-多条件、多列查找重复记录

zglibk

  请老师帮忙完善下代码，写到这个模块出现问题，写不下去了
需要实现2个功能：
    1、根据TextBox里的内容，在A、B列查重（现有的代码有问题~附件中有标明）；
    2、实现自动编号：根据窗体TextBox3的日期，生成报告编号到TextBox4 。
    附件： VBA 窗体-多条件、多列查找重复记录.rar (25.24 KB, 下载次数: 44)

2019-8-20 16:37 上传

点击文件名下载附件
================================================================
（图一）


（图二）


这个帖子有一定难度，得大师出马了

hfwufanhf2006

我下载附件看了下，我的看法完全不同：
1、录入：窗体录入完全没必要，直接在明细表录入即可，本来就没几列数据，明细表录入要节省很多代码，还直观；
     比较：窗体录入与单元格是两个不同的界面，这种反复切换增加了不必要的操作量。单元格录入也远比窗体录入视野宽广；
               单元格录入能即时检查重复，窗体录入还需要按一次按钮；
               单元格录入了就相当于保存了，窗体录入还需要很多额外代码处理；
               回放：单元格不必考虑回放，订单及品名可直接用有效性录入，效率高。窗体录入需要考虑回放以及下拉列表的创建，代码复杂效率也低；
2、报告：我没有看出你报告的独特性，我认为报告就是明细的另一种格式的表达，这很像人事档案，一个是人员资料清单，另一个是人员登记表。用函数比如vlookup就能生成，用代码从销售明细查找也简单。用窗体我就看不懂了，因为窗体是录入明细的，录一个明细立即生成一个报告？这不同的报告如何排列你也没讲。我认为有两种：一是根据不同订单的选择来个性化生成报告；另一种就是全体批量生成全部报告。不管是哪一种，在录入界面去操作都是不合适的。个性化生成报告可以在报告表中利用数据有效性来选择已经录入的订单号，动态查询销售明细数据，函数和代码方法都可行。如果需要批量生成，额外安排一个独立按钮比较好；
3、从技术角度看，总体上我认为不算太难，但你用窗体是人为增加了代码的复杂性。建议：
     1）合理利用数据有效性：这个功能被很多写代码的人遗忘，他们总喜欢自己写筛选代码来建立下拉列表，其实没必要。自己建立下拉列表需要额外使用控件，不如数据有效性方便，因为它是直接与单元格连接的，选完了数据就保存到对应单元格了，这个过程不需要代码，但控件就复杂多了。动态建立数据有效性可以先录制一个宏，稍微修改下，只需要动态添加引用范围就好了，这比写一大段筛选下拉列表代码然后还需要处理数据关联要简单多了；
     2）控件并不比单元格强：我认为控件仍被广泛使用是老程序员的问题，他们都是从传统编程语言转过来的，自然保留了使用控件的习惯。单元格与控件比较，控件能做的单元格都能做，还能做得更好。但他们的风格不太一样：单元格录入是在录入完成按回车键后再做检查，控件可以在按下每个字母和数字时做检查，这种前置检查的价值很小，所以excel舍弃了。由于这个原因，有些程序员自己用控件模拟单元格录入，多此一举，因为自己模拟的单元格哪有真正的单元格功能强大？单元格的多行编辑、多格式定义、自适应能力是控件做不了的。excel不论是工作表还是单元格，都有change和selectionchange事件，这两个分别是是录完和选择后做检查用的，利用他们可以省掉不必要的控件，因为窗体控件的存在，除了代码不能无缝融合（需要按钮执行），还有界面也是不能融合的，需要来回切换，不管从哪个角度看，在change里写代码都比控件有优势；
    3）对你这个具体文件：
         直接在销售明细录入数据，不需要录入的列可以标记颜色并锁定，由代码来动态完成，比如报告编号；
         在表单的change里做检查，可以完成：订单重复检查，利用字典检索我觉得很快，如果数据量少于10000行，用数组估计也不慢；报告编号的动态建立；
         品名可以用数据有效性辅助录入，需要代码动态建立数据引用范围的变更。如果品名是标准固定的名称，直接建立一个品名列表并引用，还能节省动态变更有效性引用的麻烦；
         报告：我不知道你是否要全体生成报告，全体报告只是单一报告的整体循环，全体报告的难点是如何设计排列格式。单一报告最简单就是用数据有效性选择关键字，数据有效性的引用列表来自销售明细表，然后用函数或者代码检索剩余的信息就完成了。

zglibk

hfwufanhf2006 发表于 2019-8-21 09:45
我下载附件看了下，我的看法完全不同：
1、录入：窗体录入完全没必要，直接在明细表录入即可，本来就没几 ...

首先，谢谢关注！
其次，我要解释一下，这个文件只是我的庞大工程的一个简单模拟。实际上，个别单个工作表列数达到40多列
1、窗体录入的必要性：工作表列数多，录入的同时需要前后检查核对，工作表中录入的话，左右拉动很费劲；
2、报告：原型大致是这样的：
  1）先录入数据保存清单后，再手工填写到格式报告中（填写格式报告的时间可选）。
   2) 生成报告：每次只需要生成1个订单号对应数据的报告，且是任意时间。
    现在已经原型中实现的有：
    a、打开工作界面→选择订单号（即ComBobox1下拉框）→界面中所有控件读取“记录表”中该订单号读取对应的数据→点击生成格式报告→写入报告模板→copy为新工作簿。
   b、重复判断：点击生成报告→检索并判断记录表中（A列订单号+B列产品名称）是否存在ComoBox1和ComBobox2内的值。Yes→ 写入报告，NO→（写错，但不知错在哪里？）
3、报告编号的生成：订单号相同、产品名称相同的，报告编号相同。没想到实现的方法。
重复判断那里，与上传的附件中不同，重写了代码，但是会弹出出错提示，把“If Me.ComboBox1.Text = rng And......End If"这段注释掉，下面的运行正常。CommandButton1完整代码如下：
'对象变量和with块变量未设置
Dim arr, i%, Dim rng, ran

    Application.DisplayAlerts = False
    If Len(ComboBox1.Text) = 0 Then MsgBox "请输入订单号！", vbCritical, "提示": Exit Sub
    If Len(ComboBox2.Text) = 0 Then MsgBox "请选择区域！", vbCritical, "提示": Exit Sub

    Set rng = Sheets("销售记录").Columns(1).Find(ComboBox1.Text, lookat:=xlWhole)
    Set ran = Sheets("销售记录").Columns(2).Find(ComboBox2.Text, lookat:=xlWhole)

    If Me.ComboBox1.Text = rng And Me.ComboBox2.Text = rng.Offset(0, 1) Then'这个代码有问题
        With Worksheets("报告")
            .Cells(4, 2).Value = ComboBox1.Text
            .Cells(4, 4).Value = ComboBox2.Text
            .Cells(5, 2).Value = TextBox1.Text
            .Cells(5, 4).Value = TextBox2.Text
            .Cells(6, 2).Value = TextBox5.Text
            .Cells(3, 3).Value = TextBox4.Text
            .Cells(3, 7).Value = TextBox3.Text
            MsgBox "报告生成完毕！", 64, "提示！"
        End With
    End If
    If rng Is Nothing Or ran Is Nothing Then
        If MsgBox("是否保存记录?", vbOKCancel) = vbOK Then
            i = Sheets("销售记录").Range("A:G").Find("*", , , 1, 1, 2).Row
            With Sheets("销售记录").Range("A" & i + 1)
                .Offset(0, 0).Value = ComboBox1.Value
                .Offset(0, 1).Value = ComboBox2.Value
                .Offset(0, 2).Value = TextBox1.Value
                .Offset(0, 3).Value = TextBox2.Value
                .Offset(0, 4).Value = TextBox5.Value
                .Offset(0, 5).Value = TextBox4.Value
                .Offset(0, 6).Value = TextBox3.Value
            With Worksheets("报告")
                .Cells(4, 2).Value = ComboBox1.Text
                .Cells(4, 4).Value = ComboBox2.Text
                .Cells(5, 2).Value = TextBox1.Text
                .Cells(5, 4).Value = TextBox2.Text
                .Cells(6, 2).Value = TextBox5.Text
                .Cells(3, 3).Value = TextBox4.Text
                .Cells(3, 7).Value = TextBox3.Text
            MsgBox "请查看记录和报告！", 64, "操作成功！"
            End With
            End With
        Else
            With Worksheets("报告")
                .Cells(4, 2).Value = ComboBox1.Text
                .Cells(4, 4).Value = ComboBox2.Text
                .Cells(5, 2).Value = TextBox1.Text
                .Cells(5, 4).Value = TextBox2.Text
                .Cells(6, 2).Value = TextBox5.Text
                .Cells(3, 3).Value = TextBox4.Text
                .Cells(3, 7).Value = TextBox3.Text
            MsgBox "请查看报告！", 64, "操作成功！"
            End With
    End If
End If

======================================================
当然，业务逻辑都还好改动，最头痛的是现在还不能实现自动报告编号，以前都人手编，要么重复，要么规则不符。
VBA我也是边用边学，请各位坛友、专家、老师不吝赐教！

hfwufanhf2006

zglibk 发表于 2019-8-21 16:24
首先，谢谢关注！
其次，我要解释一下，这个文件只是我的庞大工程的一个简单模拟。实际上，个别单个工作 ...

内容太长，我也要下班了，我也没来得及看完全，就挑对你比较困难的编号重复的问题回答：

通常字典是查重的重要手段，数组也能做到这一点，相比较字典多数情况下会快点，而数组理解起来要简单些。下面用字典来说明：

1、假设，用你附件的文件来做测试，需要先删除销售记录表的最后一行，因为最后一行内容不完整，会导致判断失误；
2、把下面的代码写在textbox4（报告编号）的MouseDown里，当你鼠标点击这个控件时就立刻有结果了：
     注意，需要删除强制变量定义，我实在是不习惯这个参数，我的变量多数都没定义。
    Dim zd As Object
    Set zd = CreateObject("scripting.dictionary")
    For i = 2 To Worksheets("销售记录").[a10000].End(3).Row
         s1 = Cells(i, 1)
         If Month(Cells(i, 5)) < 10 Then
            s2 = "PQR" & Mid(Year(Cells(i, 5)), 3, 2) & "0" & Month(Cells(i, 5))
         Else
            s2 = "PQR" & Mid(Year(Cells(i, 5)), 3, 2) & Month(Cells(i, 5))
         End If
         zd(s1) = s2
     Next
     s3 = zd.Count + 1
     s4 = IIf(s3 < 10, "00" & Trim(Str(s3)), IIf(s3 < 100, "0" & Trim(Str(s3)), Trim(Str(s3))))
     TextBox4.Text = s2 & s4 & "BG"
3、代码就这么多，我解释下：
     1）这个代码是立即动态生成一个报告编号的序列号，利用字典去掉重复值，然后字典的个数+1就是最新的编号了，所以有：
         s3 = zd.Count + 1
     2）还有一些其他的细节：

         年度保留两位，需要mid来截取；
         月份要保留两位，所以需要判断 month<10；
         编号也要保留3位，利用iif函数来实现；
4、这个代码只是模拟顺序编号，还有很多需要改进：
      窗体里有报告日期，我估计你是要用这个日期来生成编号。但我没有去读取textbox3的内容，因为我只是测试，你实际应用时修改下就成了。我没用它还有其他因素：我不知道你是即时输入的日期，还是用原来已经存在的日期，这还涉及数据“回放”，需要把原来的数据读出来，你自己适当修改；

其他我明天再看！

zglibk

hfwufanhf2006 发表于 2019-8-21 17:07
内容太长，我也要下班了，我也没来得及看完全，就挑对你比较困难的编号重复的问题回答：

通常字典是查 ...

谢谢您，辛苦了！
  关于报告编号，确实是用TextBox3的日期生成——并且逻辑是：选择订单号→填写报告日期→再TextBox4_MouseDown生成报告编号
   （通常是根据需要，在ComboBox1中选择加载（Initialize ）的A列订单号，再确定一个报告日期，在此基础上生成报告编号。）
  另外，就是：每月1号从重新从001开始（如：PQR1908666BG →PQR1909001BG），这个判断还不知道怎么写（下面注释掉的部分）


Private Sub TextBox4_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim zd As Object
   
    If Len(TextBox3.Value) = 0 Then
        MsgBox "日期不能为空 !" & Chr(13) & "格式：1999-01-01", 16, "提示": Exit Sub
        ElseIf IsDate(TextBox3.Value) = False Then MsgBox "日期格式错误，请更正!" & Chr(13) & "格式：1999-01-01", 16, "提示": Exit Sub
    End If
    Set zd = CreateObject("scripting.dictionary")
    For i = 2 To Worksheets("销售记录").[a10000].End(3).Row
        s1 = Cells(i, 1)
        If Month(TextBox3.Value) < 10 Then
            s2 = "QR" & Mid(Year(TextBox3.Value), 3, 2) & "0" & Month(TextBox3.Value)
        Else
            s2 = "QR" & Mid(Year(TextBox3.Value), 3, 2) & Month(TextBox3.Value)
        End If
        zd(s1) = s2
    Next
' If Val(Mid(Cells(i, 1), 5, 2)) <> Val(Format(Month(TextBox4.Value), "mm")) Then ' 注释掉
      '  s3 = zd.Count & Format(1, "000")

' 注释掉

   ' Else

' 注释掉

        s3 = zd.Count + 1
        s4 = IIf(s3 < 10, "00" & Trim(str(s3)), IIf(s3 < 100, "0" & Trim(str(s3)), Trim(str(s3))))
        TextBox4.Text = s2 & s4 & "BG"
  ' End If

' 注释掉

End Sub
  有劳了！！

hfwufanhf2006

zglibk 发表于 2019-8-21 21:54
谢谢您，辛苦了！
  关于报告编号，确实是用TextBox3的日期生成——并且逻辑是：选择订单号→[/backcolo ...

关于顺序编号不重复的问题，本质上还是需要逐个检索，需要考虑：
   1、具备历史编号的完整记录；
   2、根据条件筛选历史记录；
   3、对历史记录进行不重复计数；

销售记录表是我看到的唯一具有历史记录的记录表，可以利用它来做筛选：
    nian=year(textbox4.text)         '读取textbox4的年度，这是判断当前年度+月份的前提条件
    yue=month(textbox4.text)       '读取textbox4的月份
    dim zd as object                     '定义字典变量
    set zd=createobject("scripting.dictionary")
    for i=2 to worksheets("销售记录").[a10000].end(3).row
         s=cells(i,7)       '读取销售记录表的报告日期
         if (year(s)=nian) and (month(s)=yue) then
            zd(s)=i         '如果年月都相同，写入字典。字典会自动去重，所以不用考虑重复值的问题
         endif
     next i
     s=zd.count+1      '字典的总数+1就是当前编号，剩下的就是字符拼接了。如果是新的起始月份，字典的总数就是0，s=zd.count+1也成立

上述代码只是一个思路，没有实测，但我估计问题也不大。

zglibk

hfwufanhf2006 发表于 2019-8-22 09:24
关于顺序编号不重复的问题，本质上还是需要逐个检索，需要考虑：
   1、具备历史编号的完整记录；
   2 ...

老师，上面的代码已代入测试，每月重置为1的功能已OK！在此谢过！！
但还有2个问题：
    1、顺序号每次+1，现在的情况是，上次输入完保存后，下次再输入，生成的编号不会+1；
    2、同一订单号，“报告编号”相同
  本贴&#10102;楼中两大问题之一的“生成报告前查重”的功能目前已完成。以上问题为另一大问题“自动编号”中的问题
希望老师再帮帮我查找修改下代码~
2019-8-22更新附件如下：
多条件自动编号.rar (35.23 KB, 下载次数: 41)

2019-8-22 15:29 上传

点击文件名下载附件

{:9_319:}

hfwufanhf2006

1、上次输入完保存后，下次再输入，生成的编号不会+1：
     我估计不会，你需要重点检查是否真的保存到销售记录表里面了，字典只读取这个历史档案。如果没保存，那肯定是不会+1的，因此在生成报告这里面还需要有保存记录的代码。这是合理的，报告既然已生成，资料当然也必须保存。因此你那个两个按钮“报告”和“保存”其实可以合二为一；
2、同一订单号，“报告编号”相同：
     这个确实没考虑，增加一个判断条件，如果订单号已存在，直接读取历史编号就行了：
     ddh=textbox1.text  '把订单号读出来
     bz=false               '增加一个标识识别变量，默认为false
     nian=year(textbox4.text)
     yue=month(textbox4.text)      
     dim zd as object                    
     set zd=createobject("scripting.dictionary")
     for i=2 to worksheets("销售记录").[a10000].end(3).row
         if ddh=cells(i,1) then       '判断订单号是否已存在，我不记得是哪一列,cells(i,1)是随便写的
            bz=true      '如果已经找到存在的编号，直接退出，后面的工作也不用做了
            exit for
         endif
         s=cells(i,7)
         if (year(s)=nian) and (month(s)=yue) then
            zd(s)=i
         endif
     next i
     if bz then    '订单号已存在，直接读取
        textbox4.text=cells(i,1)     '记得更改成正确的列，我这是随便写的
     else
        s=zd.count+1    '需要字符拼接
        textbox4.text="PRQ" & 其他的文本拼接
     endif

建议：
   因为编号是自动生成的，所以这段代码放在订单号的选择里面比较好。选好订单号，编号也就有了。
   原来把它放在编号事件里是为了测试这段代码的可行性，主要是演示“”鼠标一点编号就有了“的功能实现

zglibk

老师，早上好！
    现在剩下1个问题：每次录入新订单号，自动编号不会+1（历史编号记录完整,但每次生成都是005BG，变量s没起作用）
    另，附上窗体控件和记录表截图。代码与实际不对应的地方已改


     dim zd as object                     '定义字典变量
     If Len(TextBox3.Value) = 0 Then
         MsgBox "日期不能为空 !" & Chr(13) & "格式：1999-01-01", 16, "提示": Exit Sub
         ElseIf IsDate(TextBox3.Value) = False Then MsgBox "日期格式错误，请更正!" & Chr(13) & "格式：1999-01-01", 16, "提示": Exit Sub
     End If
   
     ddh = ComboBox1.Text         '把订单号读出来
     bz = False                            '增加一个标识识别变量，默认为false
     nian = Year(TextBox3.Text)   '读取textbox3的年度，判断当前年度+月份的前提条件
     yue = Month(TextBox3.Text) '读取textbox3的月份
     Set zd = CreateObject("scripting.dictionary")
     For i = 2 To Worksheets("销售记录").[a10000].End(3).Row
         If ddh = Cells(i, 1) Then    '判断订单号是否存在
            bz = True    '如果已经找到存在的编号，直接退出
            Exit For
         End If
         s = Cells(i, 7)  '读取销售记录表的报告日期
         If Month(TextBox3.Value) < 10 Then
            s2 = Mid(Year(TextBox3.Value), 3, 2) & "0" & Month(TextBox3.Value)
        Else
            s2 = Mid(Year(TextBox3.Value), 3, 2) & Month(TextBox3.Value)
        End If
        If (Year(s) = nian) And (Month(s) = yue) Then
            zd(s) = i      '如果年月都相同，写入字典。
        End If
     Next i
     If bz Then           '订单号已存在，直接读取
        TextBox4.Text = Cells(i, 1).Offset(0, 5)
     Else
        s = zd.Count + 1 '字典的总数+1就是当前编号
         s4 = IIf(s < 10, "00" & Trim(str(s)), IIf(s < 100, "0" & Trim(str(s)), Trim(str(s))))
        TextBox4.Text = "RQ" & s2 & s4 & "BG"      ' 字符拼接——P字母在贴子老变成表情
     End If

     以上读代码确实应该自动+1，但它就是不递增，辛苦老师了，帮我查查哪里的问题。
2019-8-23 0:39更新附件
多条件自动编号.rar (33.68 KB, 下载次数: 73)

2019-8-23 00:46 上传

点击文件名下载附件

hfwufanhf2006

zglibk 发表于 2019-8-22 17:18
老师，早上好！
    现在剩下1个问题：每次录入新订单号，自动编号不会+1（历史编号记录完整,但[/backcolo ...

问题出在字典的键值key：
     zd(s) = i
     这里的s=cells(i,7)，就是报告时间，因为时间有重复值，字典自动去重，所以时间相同的被忽略了；
  改成按照订单号创建key：
     在原代码s=cells(i,7)的下面，增加一个参数：
     s1=cells(i,1)    '读取订单号，原来的s=cells(i,7)还是需要的，因为需要判断年月
     写入字典改成：
     zd(s1)=i

  循环体内的完整代码是：
     For i = 2 To Worksheets("销售记录").[a10000].End(3).Row
         If ddh = Cells(i, 1) Then
            bz = True
            Exit For
         End If
         s = Cells(i, 7)
         s1 = Cells(i, 1)  '读取订单号
         If Month(TextBox3.Value) < 10 Then
            s2 = Mid(Year(TextBox3.Value), 3, 2) & "0" & Month(TextBox3.Value)
        Else
            s2 = Mid(Year(TextBox3.Value), 3, 2) & Month(TextBox3.Value)
        End If
        If (Year(s) = nian) And (Month(s) = yue) Then
            zd(s1) = i      '按照订单号写入字典，订单号相同的才去重。
        End If
     Next i

因为这段代码使用了字典，最后我在顺便把字典的主要使用方法解释下：   1、字典是系统内置对象，其实是外置的，但系统内置支持，可以视同内置对象。需要用createobject创建；
     字典对象定义为object，object一般是最高层级的父对象，对象是继承的，大多数对象的最高层父对象都是object；
2、字典本质上可以看成是一个数组系列，他们也是按照类似数组那样的顺序来存放数据的，结构是：
     zd(key)=zd.item
     左边是key，右边是item。通俗说就是左边是关键字，右边是结果；
3、字典的方法主要有：
     add 添加
     remove 删除
     removeall 删除所有
     exists 判断key是否已存在
     count  字典个数
     keys  所有的键值列表
     items 所有的内容列表

     虽然字典有add方法，但通常是直接写成zd(key)=item的比较多，因为add方法需要自己来判断是否重复，如果在有重复的情况下用add添加重复值会出错，而zd(key)=item的写法就不成在这个问题，字典会自动维护key的唯一性，如果有重复再写，重复值会被忽略。这也是字典比数组快的原因，数组要去重，需要for循环查找排除。在重复值比较多的情况下（不重复值小于200），两者的速度相等（数组可能还略快），在不重复值大于2000以上，for循环明显费时间，不重复值越多，速度差异越大；
4、add、remove和removeall基本用不上的，使用价值比较高的就是count、exists和keys这三个
     count前面用过了
     exists:
        if zd.exists(key) then
        通常用于比较两个数据集，类似vlookup函数，先把一个数据集存放在字典中然后读取另一个数据集来查字典是否存在。如果不用字典，这类查询通常用双循环，其中一个循环与创建字典是相同的，但另一个查询循环的效率就比字典的exists判断要慢得多，不管字典数据量多少，这个判断都是瞬间的，所以字典查询也比双循环要快，数据集越大速度差异也越大。10000以上的数据量就能感觉到速度差异来；
     keys:
        dim arr
        arr=zd.keys
        for i=1 to ubound(arr)
             利用循环和数组可以把所有的字典键值读出来，items也可以用同样的方法，但使用的概率很低，因为知道了key，zd(key)就是item了
        next
5、zd(key)=item的含义
     右边的item是存放的内容，对于上面的实例，zd(s)=i，这里i其实是没有意义的，因为我们需要的只是字典的数量，至于内容是不需要的，所以随便输入一个什么内容都可以的，写成zd(s)=1也行；
     其实是很有用的，对于查询和分类汇总，内容就很有价值了。关于分类汇总，使用的难度有点大，我暂且不提，你先知道它很有价值就行了