|
衷心谢谢 sgrshh29 原工程是用 vb+mdb 作的 ，excel文件只是为了便于说明！ 算法思路基本一致，不过我不喜欢递归，特别是记录太大，堆是无法控制的。 Public Sub 获取子目录()
s = GetListId(22, GetDcyGidId([A2:A35]))
End Sub '搜索关于某Gid下所有占用的id列表
Private Function GetListId(strIndex As String, ByVal dcy As Dictionary) As String
Dim i As Integer, blnX As Boolean
Dim strFirst As String, strNew As String, strLast As String
Dim arrTemp As Variant, strTemp As String
strFirst = dcy(strIndex)
arrTemp = Split(strFirst, ",")
100
For i = 0 To UBound(arrTemp)
strTemp = dcy(CStr(arrTemp(i)))
If strTemp <> "" Then
strNew = strTemp & "," & strNew
blnX = True '标示有新内容
End If
Next
If blnX Then '标示有新内容
strLast = strLast & strNew '保存字符串
arrTemp = Split(Left(strNew, Len(strNew) - 1), ",") '分解成数组
strNew = "": blnX = False '清空
GoTo 100 '重新读取Split(strNew, ",")
End If
GetListId = strLast & strFirst
End Function '----------------------------------------------------------------------
Private Function GetDcyGidId(ByVal rngs As Range) As Dictionary Dim dcy As New Dictionary
Dim strId As String, strGid As String
Dim r1 As Range For Each r1 In rngs strGid = r1.Offset(0, 1).Value 'gid
strId = r1.Value 'id If strGid = "" Then GoTo 100 '排除空白 If Not dcy.Exists(strGid) Then
dcy.Add strGid, strId
Else
dcy(strGid) = dcy(strGid) & "," & strId
End If
100 Next
Set GetDcyGidId = dcy
End Function 使用递归：
Public Sub 获取子目录()
Dim dcyGidId As Dictionary
Set dcyGidId = GetDcyGidId([A2:A35])
[l4] = GetChildListId(dcyGidId, dcyGidId(CStr(23))) & dcyGidId(CStr(23))
End Sub
Private Function GetChildListId(ByVal dcyGidId As Dictionary, ByVal strIds As String) As String
Dim i As Integer, blnX As Boolean
Dim strNew As String, strTarget As String
Dim arrTemp As Variant, strTemp As String
arrTemp = Split(strIds, "@")
For i = 0 To UBound(arrTemp)
strTemp = dcyGidId(CStr(arrTemp(i)))
If strTemp <> "" Then
strNew = strTemp & "@" & strNew
blnX = True '标示有新内容
End If
Next
If blnX Then strTarget = GetChildListId(dcyGidId, Left(strNew, Len(strNew) - 1)) & strNew
'标示有新内容
GetChildListId = strTarget
End Function '----------------------------------------------------------------------
Private Function GetDcyGidId(ByVal rngs As Range) As Dictionary Dim dcy As New Dictionary
Dim strId As String, strGid As String
Dim r1 As Range For Each r1 In rngs strGid = r1.Offset(0, 1).Value 'gid
strId = r1.Value 'id If strGid = "" Then GoTo 100 '排除空白 If Not dcy.Exists(strGid) Then
dcy.Add strGid, strId
Else
dcy(strGid) = dcy(strGid) & "@" & strId
End If
100 Next
Set GetDcyGidId = dcy
End Function | 
楼主: 彭希仁
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2008-6-4 21:57
楼主
