运行时错误“424”要求对象

①然如故

老师您好，自动生成字母+日期+序号的代码放在明细表中很好用，后来我把代码搬到了“资料库”表利用窗体录入资料时“自动生成序号”代码出“类型不匹配”，如果是在资料库直接录入内容就不会出错，耽误老师宝贵时间请帮我纠正下代码，谢谢！
华星帐套0529.rar (460.62 KB, 下载次数: 27)

2018-5-30 08:40 上传

点击文件名下载附件

liulang0808

字典变量没有初始化吧
set d=。。。。
然后再使用，在表内的话，selectionchange事件对字典进行了处理
如果把SelectionChange事件屏蔽，照样会报错的

①然如故

liulang0808 发表于 2018-5-30 07:35
字典变量没有初始化吧
set d=。。。。
然后再使用，在表内的话，selectionchange事件对字典进行了处理

liulang0808您好，能否请您帮修改下，菜鸟成分感激，谢谢！

liulang0808

①然如故 发表于 2018-5-30 08:11
liulang0808您好，能否请您帮修改下，菜鸟成分感激，谢谢！

不好意思，附件内容太多，看不太懂
上面的意见也仅仅是根据局部代码猜的。
另外字典变量d在使用前需要赋值的，不赋值没有意义的，具体在哪里赋值看楼主的具体应用了

①然如故

liulang0808 发表于 2018-5-30 08:23
不好意思，附件内容太多，看不太懂
上面的意见也仅仅是根据局部代码猜的。
另外字典变量d在使用前需要 ...

liulang0808您好,我已把无关代码都给删除了，这样看起来就不会感觉太复杂了，希望能得到您的帮助，菜鸟感激涕零！
附件已更新
有关代码如下：
资料库表

Option Explicit

Dim d, k, t, d1  'A列自动生成序号(1)

Dim crr, i& ', tms  'A列自动生成序号(1)

Private Sub Worksheet_Change(ByVal targetAs Range)  'A列自动生成序号(3)

If target.Count > 1 Then Exit Sub

If target.Column = 3 And target.Row > 2Then

If target = "" Thentarget.Offset(0, -2) = "": GoTo 10

Dim rq$, mc$, n, n1, xh

rq = Right(Year(Date), 2) &Format(Month(Date), "00") & Format(Day(Date), "00")

mc = target.Value

If d.exists(rq) Then

    xh = d(rq)

   If d1.exists(rq & "|" & mc) Then

       n1 = d1(rq & "|" & mc)

       target.Offset(0, -2) = crr(n1, 1)

   Else

       target.Offset(0, -2) = "HX" & rq & Format(xh + 1,"00")

   End If

Else

   target.Offset(0, -2) = "HX" & rq & "01"

End If

10:

target.Offset(0, 1).Select

End If

End Sub

Private Sub Worksheet_SelectionChange(ByValtarget As Range)  'A列自动生成序号(2)

If target.Count > 1 Then Exit Sub

If target.Column <> 3 Or target.Row< 3 Then Exit Sub

Dim aa$, xh

Set d =CreateObject("Scripting.Dictionary")

Set d1 =CreateObject("Scripting.Dictionary")

crr = Sheet12.UsedRange

For i = 3 To UBound(crr)

   aa = Mid(crr(i, 1), 3, 6)

   xh = Val(Right(crr(i, 1), 2))

   If xh > d(aa) Then d(aa) = xh

   d1(aa & "|" & crr(i, 3)) = i

Next

k = d.keys: t = d.items

End Sub

录入窗体代码如下：

Private Sub 添加_Click()
    Dim a As Integer
    Dim i As Long
    Dim myControl As Control
     Set d = CreateObject("Scripting.Dictionary")
       arr = Sheets("资料库").Range("b3:c" & Sheets("资料库").[c999].End(3).Row)
         For i = 1 To UBound(arr)
      d(arr(i, 1) & arr(i, 2)) = i
    Next
     If d.exists(客户类别.Value & 客户名称.Value) Then
       CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示" '提示框延时
        Unload Me
      Exit Sub
    End If
  a = Sheets("资料库").[b65536].End(xlUp).Row '取得行号
    With Sheets("资料库").Range("A" & a + 1) '找到存档表最后一行下的空行
'        .Value = 日期.Value '号码
        .Offset(0, 1).Value = 客户类别.Value
        .Offset(0, 2).Value = 客户名称.Value
        .Offset(0, 3).Value = 职务.Value
        .Offset(0, 4).Value = 姓名.Value
        .Offset(0, 5).Value = 移动电话.Value
        .Offset(0, 6).Value = 业务电话.Value
        .Offset(0, 7).Value = 电子邮件.Value
        .Offset(0, 8).Value = 开户银行.Value
        .Offset(0, 9).Value = 帐号.Value
        .Offset(0, 10).Value = 地址.Value
        .Offset(0, 11).Value = 备注.Value
    With Sheets("出入库")
      Sheet6.Unprotect Password:="lidayu" '触发单元格即取消工作表保护
        For Each myControl In Me.Controls
            If InStr(myControl.Name, "客户名称") Then
                If Len(myControl.Name) > 4 Then
                    If myControl.Value = "" Then Exit For
                    n = n + 1
                    i = .[x1].CurrentRegion.Rows.Count + 1
                    .Cells(i, 24) = myControl.Text
                    If n = 1 Then
                        .Cells(i, 25) = Me.Controls("combobox1").Text
                        .Cells(i, 26) = Me.Controls("产品名称").Text
                        .Cells(i, 27) = Me.Controls("销售价格").Text
                    Else
                        .Cells(i, 25) = Me.Controls("combobox" & n).Text
                        .Cells(i, 26) = Me.Controls("产品名称" & n).Text
                        .Cells(i, 27) = Me.Controls("销售价格" & n).Text
                    End If
                End If
            End If
        Next
    End With
    CreateObject("WScript.Shell").Popup "您已保存成功!", 1, "提示" '提示框延时
    Sheet6.Protect Password:="lidayu", DrawingObjects:=True, Contents:=True, AllowFormattingColumns:=True, _
    AllowFormattingRows:=True, AllowFormattingCells:=True

      Unload Me '卸载 我（窗体）
        End With
End Sub

①然如故

恭候高手帮助！

蓝桥玄霜

请见附件。

①然如故

蓝桥玄霜 发表于 2018-6-2 12:09
请见附件。

蓝版您好，非常感谢您再次的帮助，代码运行达到要求。能否多增加当“资料库”表C列内容再一次更改A列序号不更新为当前时间，还是保留原来的序号。
这是在论坛上看到的不随单元格内容变动更新日期序号的代码

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim rng As Range
   
3.     With Target    '当前变动的单元格或变动的区域
   
4.         If Target.Column = 3 And Target.Row > 2 Then    '假设起始变动单元格的列为C列时，则
   
5.             For Each rng In Target    '在每一个的变动单元格里
   
6.                 If rng.Column = 3 Then  '如果列为3
   
7.                     rng.Offset(0, -2).Value = IIf(rng.Value <> "", Date, rng.Offset(0, -2).Value)   '如果变动单元格为空，则为空，否则为now，
   
8.                 End If
   
9.             Next
   
10.         End If
    
11.     End With
    
12. End Su
    

复制代码

EH258369

还是没搞懂！