excel 更新For Each循环变量

vom3gejh  于 12个月前  发布在  其他
关注(0)|答案(1)|浏览(84)


的数据
目的是找到列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 separated 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 concatenated 
                                                                          with initial firstvalue
        End If
        Next n                        
        MsgBox firstvalue
        'Now I want to iterate 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

字符串
这段代码是为初始的第一个值工作,可以任何一个建议任何方法来覆盖更新的第一个值。

aiazj4mn

aiazj4mn1#

我不确定我是否完全理解了你的目标,但是这段代码应该可以找到每个任务的所有precedent:

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

字符串

相关问题