请问各位高手怎样用VB自动分类清单的型号,对相同的型号递加赋值,多谢.

Question

ID       备件名称     型号    数据代码
1           电脑        xx1          407001
2           电脑        xx1          407001
3           电脑        xx1          407001
4           电脑        xx2          407002
5           电脑        xx2          407002
6           电脑        xx3          407003
7           电脑        xxx          407004
8           电脑        xxx          407004大家好,我想用VB,把这些型号相同的自动加上"数据代码",代码的规则如上表所示,
电脑所属的代码头缀是: 407(这个是不变的), 然后用VB自动分类,把[型号]相同的加上后缀,后缀从001开始,相同的型号就递加,遇到不同型号了,就自动从002重新开始递加.具体效果请看上表的"数据代码"
这个能否用程序实现?请高人帮下忙,小弟不知从何入手.多谢大家

Answer 1

请参考：
Sub test()
    Debug.Print GetDataNumber("xx1,xx2,xx1,xx2,xx3,xx4,xx1,xx4,xx5")
End Sub
Function GetDataNumber(ByVal bStr As String) As String
    ''由于数据不知道来自哪里，暂且认为来自字符串，如：xx1,xx2,xx2,xx3,xx4...
    ''引用Microsoft Scripting Runtime
    ''bStr可以是排序好的，也可以是凌乱的
    Dim w1 As String, i As Long, iDic As New Dictionary, ww
    ww = Split(bStr, ",")
    For i = 0 To UBound(ww)
        w1 = LCase$(ww(i))
        If Not iDic.Exists(w1) Then
            ''如果该型号字典中没有，则追加，并且用字典的数量+1作为相应的编号
            iDic(w1) = "407" & Format$(iDic.Count + 1, "000")
        End If
    Next
    ''按照传入的字符串的顺序输出相应的编码
    w1 = ""
    For i = 0 To UBound(ww)
        w1 = w1 & IIf(w1 <> "", ",", "") & iDic(LCase$(ww(i)))
    Next
    GetDataNumber = w1 ''返回对应的编码字符串
    iDic.RemoveAll
    Set iDic = Nothing
End Function

Answer 2

可以利用 ListBox 控件（可设置为 Visibal = False）。假定你的数据已经在记录集对象 rs 中。
Private Declare Function SendMessagebyString Lib _
"user32" Alias "SendMessageA" (ByVal hWND As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As LongPrivate Const LB_FINDSTRINGEXACT = &H1A2    '在 ListBox 中精确查找Private Sub Command1_Click()
Dim n As Long
    List1.Clear
    Do Until rs.EOF
        n = SendMessagebyString (List1.hWnd, LB_FINDSTRINGEXACT, -1, rs.Fields("型号"))
        If n = -1 Then
            List1.AddItem rs.Fields("型号")
            n = List1.NewIndex
            List1.ItemData(n) = 407001 + n
        End If
        rs.Fields("数据代码") = List1.ItemData(n)
        rs.Update
        rs.MoveNext
    Loop
End Sub