excel - 更新每个循环变量

Question

目的是找到 c 列中的值与从更新的“firstvalue”变量获得的所有值之间的循环性，这些值以逗号分隔并存储在“M”列中。

Sub circular()
Dim rng As Range, rng2 As Range, firstvalue As String, secondvalue As String
Set sh = ThisWorkbook.Worksheets("Sheet1")
lr = sh.Range("C" & Rows.Count).End(xlUp).Row
For Each rng In sh.Range("C5:C" & lr) 'iterating over each cell in column "c" from C5 till lastrow "lr". 
        firstvalue = rng.Offset(0, 10).value 'Corresponding cell value which is comma seperated in column 
                                              "M" i:e after 10 columns from "C".    
        Dim n As Variant
        For Each n In Split(firstvalue, ",")   'Looping through each value obtained from split function.
        Set rng2 = sh.Range("C5:C" & lr).Find(Trim(n), LookIn:=xlValues)  'Finding that split value again 
                                                                          in column "C".
        If Not rng2 Is Nothing Then                                      'if exists in column c then get. 
        secondvalue = rng2.Offset(0, 10).value                           'corresponding cell values.    
        firstvalue = firstvalue & "," & secondvalue                      'now first value is concatnated 
                                                                          with initial firstvalue
        End If
        Next n                        
        MsgBox firstvalue
        'Now i want to itterate over updated "firstvalue" in split function and this goes on in circular 
         fashion until rng value exists in firstvalue. 
Next rng            'then change next rng and continue the above whole process for this value and so on.
End Sub

此代码适用于初始第一个值，任何人都可以建议任何方法来迭代更新的第一个值。

标签： excelvbadictionaryfor-loop

Answer 1

我不确定我是否完全理解你的目标，但这段代码应该找到每个任务的所有前辈：

Sub circular()
Dim sh As Worksheet
Dim rTask As Range
Dim oCell As Range
Dim oFound As Range
Dim lr As Long, j As Long
Dim aPredecessors As Variant
Dim sCurTask As String
Dim secondValue As String
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    lr = sh.Range("C" & Rows.Count).End(xlUp).Row
    Set rTask = sh.Range("C5:C" & lr)
    
    For Each oCell In rTask
        sCurTask = Trim(oCell.Text)
        aPredecessors = getPredecessors(Trim(oCell.Offset(0, 10).Text))
        j = LBound(aPredecessors)
        Do Until j > UBound(aPredecessors)
            secondValue = aPredecessors(j)
            If sCurTask = secondValue Then
                ReDim Preserve aPredecessors(j)
                Debug.Print "Task '" & sCurTask & "': Cyclic link '" & secondValue & "' for '" & Join(aPredecessors, ",") & "'!"
                aPredecessors(j) = aPredecessors(j) & " !!!"
            Else
                If secondValue <> vbNullString Then
                    Set oFound = rTask.Find(secondValue, LookIn:=xlValues)
                    If oFound Is Nothing Then
                        ReDim Preserve aPredecessors(j)
                        Debug.Print "Task '" & sCurTask & "': Task '" & secondValue & "' for '" & Join(aPredecessors, ",") & "' not found!"
                        aPredecessors(j) = aPredecessors(j) & " ???"
                    Else
                        Call addNewTasks(aPredecessors, Trim(oFound.Offset(0, 10).Text))
                    End If
                End If
            End If
            j = j + 1
        Loop
        oCell.Offset(0, 11).Value = Join(aPredecessors, ",")
    Next oCell
End Sub

Function getPredecessors(sPredecessors As String)
Dim i As Long
Dim aTemp As Variant, sRes As String
Dim sTest As String
    sRes = vbNullString
    aTemp = Split(sPredecessors, ",")
    For i = LBound(aTemp) To UBound(aTemp)
        sTest = Trim(aTemp(i))
        If InStr("," & sRes & ",", "," & sTest & ",") = 0 Then sRes = sRes & sTest & ","
    Next i
    If Len(sRes) > 1 Then sRes = Left(sRes, Len(sRes) - 1)
    getPredecessors = Split(sRes, ",")
End Function

Sub addNewTasks(aData As Variant, sPredecessors As String)
Dim i As Long, uB As Long
Dim aTemp As Variant
Dim sTest As String, sValid As String
    aTemp = Split(sPredecessors, ",")
    If UBound(aTemp) >= 0 Then ' Not empty
        sValid = "," & Join(aData, ",") & ","
        For i = LBound(aTemp) To UBound(aTemp)
            sTest = Trim(aTemp(i))
            If sTest <> vbNullString Then
                If InStr(sValid, "," & sTest & ",") = 0 Then
                    uB = UBound(aData) + 1
                    ReDim Preserve aData(uB)
                    aData(uB) = sTest
                    sValid = "," & Join(aData, ",") & ","
                End If
            End If
        Next i
    End If
End Sub