如何遍历数组的各个单元

Question

继承了一个不是100％可用的宏，我需要对其进行修复。本质上，它应该检查是否填充了每个参考单元，如果为true，则复制到计划单元，如果isEmpty，则不执行任何操作。但是似乎无论如何它都会复制。

尝试为每个循环添加，但是似乎没有生效。

refGap = findRefGap(refCol, LR, valToCopy)
planGap = findPlanGap(refCol, LR)



For i = 23 To LR
    'Checks to see if the cell is actually referencing a product.
    If IsEmpty(Cells(i, prodCol).value) = False And Cells(i, prodCol).value <> "Result" Then
'        RefPt is the row where ref demand is found, same with planPt to planned non-promoted volume.
        refPt = i + refGap
        planPt = i + planGap

        Range(Cells(refPt, calCol), Cells(refPt, LC)).copy
        Range(Cells(planPt, calCol), Cells(planPt, LC)).PasteSpecial xlPasteValues

    End If
Next

Answer 1

也许是这样？

Sub tgr()

    Dim ws As Worksheet
    Dim rPlan As Range
    Dim rReference As Range
    Dim sHeadersCol As String
    Dim sFirst As String
    Dim lCol As Long

    Set ws = ActiveWorkbook.ActiveSheet
    sHeadersCol = "A"

    Set rPlan = ws.Columns(sHeadersCol).Find("Plan", ws.Cells(ws.Rows.Count, sHeadersCol), xlValues, xlWhole)
    If Not rPlan Is Nothing Then
        sFirst = rPlan.Address
        Do
            Set rReference = ws.Range(rPlan, rPlan.End(xlDown)).Find("Reference", rPlan, xlValues, xlWhole)
            If Not rReference Is Nothing Then
                For lCol = rPlan.Column + 1 To rPlan.Column + rPlan.CurrentRegion.Columns.Count - 1
                    If Len(Trim(ws.Cells(rReference.Row, lCol).Value)) > 0 Then ws.Cells(rPlan.Row, lCol).Value = ws.Cells(rReference.Row, lCol).Value
                Next lCol
            End If
            Set rPlan = ws.Columns(sHeadersCol).Find("Plan", rPlan, xlValues, xlWhole)
        Loop Until rPlan.Address = sFirst
    End If

End Sub