[已解决]求助！VBA编译错误！

aj1314520

求大仙们帮我看看这段代码的错误在哪里？？
本来要达到的效果是，在录入时，如果名称重复，对应行的指定字符，现在提示编译错误！！！！求助啊！

Private Sub CommandButton8_Click() '生成编码
Application.ScreenUpdating = False
If ComboBox1cd.Value = "" Or ComboBox2xlfn.Value = "" _
    Or ComboBox3xz.Value = "" Or ComboBox5xnfn.Value = "" Or ComboBox6pppai.Value = "" Or ComboBox4cdxn.Value = "" Then
   
    MsgBox "*号为必填项，请输入完整！"
    Exit Sub
Else
    Dim Arr(1 To 7)
   
    Dim Newarr
    Windows("编码库.xls").Visible = True
    With Sheets("参数")
   
   
    Arr(1) = Format(Application.WorksheetFunction.VLookup(ComboBox1cd.Value, .Range("A2", "B" & EndrowA), 2, 0), "0")
   
    Arr(2) = Format(Application.WorksheetFunction.VLookup(ComboBox2xlfn.Value, .Range("D2", "E" & EndrowD), 2, 0), "00")
   
    Arr(4) = Format(Application.WorksheetFunction.VLookup(ComboBox5xnfn.Value, .Range("J2", "K" & EndrowJ), 2, 0), "00")
   
    Arr(5) = Format(Application.WorksheetFunction.VLookup(ComboBox6pppai.Value, .Range("M2", "N" & EndrowM), 2, 0), "00")
   
    Arr(6) = Format(Application.WorksheetFunction.VLookup(ComboBox4cdxn.Value, .Range("P2", "Q" & EndrowP), 2, 0), "00")
   
    Arr(7) = Format(Application.WorksheetFunction.VLookup(ComboBox3xz.Value, .Range("S2", "T" & EndrowS), 2, 0), "0")
   
    Newrow = Sheets("数据库").Range("A65536").End(xlUp).Row
    If Newrow >= 2 Then
        ReDim Newarr(2 To Newrow)
            For i = 2 To Newrow
            Newarr(i) = Val(Mid(Sheets("数据库").Range("A" & i).Text, 4, 3))
            Next i
        G = Format(Application.WorksheetFunction.Max(Newarr) + 1, "000")
        Else
         With Sheets("数据库")
        Set Rngb = .Range("B2", "B" & Newrow).Find(what:=TextBox1.Text, LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlNext)
                If Not Rngb Is Nothing Then
                    Windows("编码库.xls").Visible = False
                    y = Val(Mid(Sheets("数据库").Range("A" & i).Text, 4, 3))
                    
                    If y = 1 Then Val (Mid(Sheets("数据库").Range("A" & i).Text, 4, 3))
                    If y = 2 Then Exit Sub
                    Exit Sub
    Else
        G = "001"
    End If
   
    Arr(3) = G
    TextBox4.Text = Join(Arr, "")
   
    TextBox4.Enabled = False
    TextBox4.BackColor = &H80000003
   
End With
Windows("编码库.xls").Visible = False
End If
Application.ScreenUpdating = True
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2012-7-15 08:48

在你的基础上修改：
Private Sub CommandButton8_Click()    '生成编码
    If ComboBox1cd.Value = "" Or ComboBox2xlfn.Value = "" _
       Or ComboBox3xz.Value = "" Or ComboBox5xnfn.Value = "" Or ComboBox6pppai.Value = "" Or ComboBox4cdxn.Value = "" Then
        MsgBox "*号为必填项，请输入完整！"
        Exit Sub
    Else
        Dim Arr(1 To 7)
        Windows("编码库.xls").Visible = True
        With Sheets("参数")
            Arr(1) = Format(Application.WorksheetFunction.VLookup(ComboBox1cd.Value, .Range("A2", "B" & EndrowA), 2, 0), "0")
            Arr(2) = Format(Application.WorksheetFunction.VLookup(ComboBox2xlfn.Value, .Range("D2", "E" & EndrowD), 2, 0), "00")
            Arr(4) = Format(Application.WorksheetFunction.VLookup(ComboBox5xnfn.Value, .Range("J2", "K" & EndrowJ), 2, 0), "00")
            Arr(5) = Format(Application.WorksheetFunction.VLookup(ComboBox6pppai.Value, .Range("M2", "N" & EndrowM), 2, 0), "00")
            Arr(6) = Format(Application.WorksheetFunction.VLookup(ComboBox4cdxn.Value, .Range("P2", "Q" & EndrowP), 2, 0), "00")
            Arr(7) = Format(Application.WorksheetFunction.VLookup(ComboBox3xz.Value, .Range("S2", "T" & EndrowS), 2, 0), "0")
        End With
        W = Sheets("数据库").Range("A65536").End(3).Row
        If W = 1 Then LSH = 1: GoTo 10
        Brr = Sheets("数据库").Range("A2:B" & W)
        For I = 1 To UBound(Brr)
            If LSH < Val(Mid(Brr(I, 1), 4, 3)) Then LSH = Val(Mid(Brr(I, 1), 4, 3))
            If Brr(I, 2) = TextBox1.Text Then LSH = Val(Mid(Brr(I, 1), 4, 3)): GoTo 10
        Next
        LSH = LSH + 1
10      Arr(3) = Format(LSH, "000")
        TextBox4.Text = Join(Arr, "")
        TextBox4.Enabled = False
        TextBox4.BackColor = &H80000003
    End If
    Windows("编码库.xls").Visible = False
End Sub

跳转到最佳答案楼层

zjdh

我也晕了   
没仔细看宏！
.

aj1314520

zjdh 发表于 2012-7-14 16:35
我也晕了   
没仔细看宏！
.

不好意思哈，我是新手，弄来弄去弄不好了，只有向您求助啦！

zjdh

你就说一下编码是如何产生的吧！
例如：CAF008-020704-E 中 008  是如何产生的？

aj1314520

zjdh 发表于 2012-7-14 18:40
你就说一下编码是如何产生的吧！
例如：CAF008-020704-E 中 008  是如何产生的？

008是流水号，从001开始累加的，因为想要做到的效果是，如果产品名称一样的情况下，流水码自动套用之前的那个流水号，如之前是CAF008-020704-E，那这次也是CAF008-020704-E，只是整组数据不能重复，品名重复时，流水号重复。

aj1314520

aj1314520 发表于 2012-7-14 19:31
008是流水号，从001开始累加的，因为想要做到的效果是，如果产品名称一样的情况下，流水码自动套用之前的 ...

是啊，开始那个本来我的意思是在录入名品名称时，如果发现有重复的产品名称，则直接复制那个流水号，

aj1314520

zjdh 发表于 2012-7-14 18:40
你就说一下编码是如何产生的吧！
例如：CAF008-020704-E 中 008  是如何产生的？

大大，救俺一命吧，为了这个，连续一个周加班到12点了~！

zjdh

可你为啥第一行与第二行相同的名称用不同的流水号？
第三行至第十四行名称不同，用相同的流水号？
所以我说看不懂啦！

aj1314520

zjdh 发表于 2012-7-14 19:59
可你为啥第一行与第二行相同的名称用不同的流水号？
第三行至第十四行名称不同，用相同的流水号？
所以我 ...

就是因为做不出要的那个效果，所以一直在测试，就是生成不了~~~急死人了。呜呜，那个数据都是错误的，不是我要的效果，大大，我的意思理解了没~~

aj1314520

aj1314520 发表于 2012-7-14 20:06
就是因为做不出要的那个效果，所以一直在测试，就是生成不了~~~急死人了。呜呜，那个数据都是错误的，不是 ...

我要的是如果名称相同，则流水号相同~~