Question

我有这个问题：

由于我在这里工作，每个职位都有一对。我想循环遍历整个列表并计算每个位置对的值差异（所以我想找到损失或增益），并将其返回到另一个单元格。这里第一个位置对的差值是14688，下面是另一个位置对。在这里有一些很棒的人的帮助下，我使用了 Area 属性，因为我的数据结构是一个由空单元格分隔的非空单元格。但是，我需要一个代码来考虑具有连续非空单元格的数据，如下所示，并仍然将它们配对。

第一个位置在第63行。

Sub main()
    Dim iPair As Long
    Dim pairDiff As Variant


    pairDiff = 1

    With Worksheets("System 1") 
        With .range("T39", .Cells(.Rows.Count, "T").End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers) '<--| loop through column "T" cells containing numbers from row 63 down to last not empty one
            iPair = 1 '<--| initialize "pair" counter
            Do While iPair < .Areas.Count '<--| loop through "pairs"
                 pairDiff = .Areas(iPair + 1).Offset(, 1) + .Areas(iPair).Offset(, 1)
                .Areas(iPair + 1).Offset(, IIf(pairDiff < 0, 7, 8)) = pairDiff '<--| write "pair" difference in corresponding column "V" (if loss) or "W" (if gain)
                iPair = iPair + 2 '<--| update "pair" counter by adding two not to mix "pairs"
            Loop
        End With
    End With
End Sub

有任何帮助吗？如果你需要我特定我的问题，我会相应地编辑它。谢谢。

Answer 1

Areas仍然有用，只需要遍历每个Area单元格

选项明确

Sub main()
    Dim ielem As Long
    Dim pair1stValue As Double, pairDiff As Double
    Dim area As Range, cell As Range

    With Worksheets("lossgain") '<-- change "losspair" to your actual worksheet name
        With .Range("T63", .Cells(.Rows.Count, "T").End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers) '<--| loop through column "T" cells containing numbers from row 63 down to last not empty one
            For Each area In .Areas
                For Each cell In area.Cells
                    ielem = ielem + 1
                    If Int(ielem / 2) * 2 = ielem Then
                        pairDiff = cell.Offset(, 1) - pair1stValue  '<--| calculate the "pair" difference from corresponding column "U" values
                        cell.Offset(, IIf(pairDiff < 0, 2, 3)) = pairDiff '<--| write "pair" difference in corresponding column "V" (if loss) or "W" (if gain)
                    Else
                        pair1stValue = cell.Offset(, 1)
                    End If
                Next
            Next
        End With
    End With
End Sub

循环识别我的数据中的对

1 个答案: