VBA将列读入数组并基于来自两列的IF条件和值

时间:2017-08-03 11:21:41

标签: excel vba excel-vba automation

正如@sktneer在我之前的query中正确地建议在处理大数据时将数据读入数组。

我想读取范围A的数组到最后,如果A1中的值等于“L”,则添加B1 + C1

我正在将此公式转换为以下代码=IF(A1="Male",C1+D1,FALSE)

Sub ANewMacro()
    Dim lr As Long, i As Long, j As Long
    Dim c, d, x, y()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    x = Range("A1:A" & lr).Value
    c = Range("C1:C" & lr).Value
    d = Range("D1:D" & lr).Value
        ReDim y(1 To UBound(x, 1), 1 To 1)
        j = 1
        For i = 1 To UBound(x, 1)
            If x(i, 1) = "L" Then
                y(i, 1) = c(i, 1) + d(i, 1)
                j = j + 1
            ElseIf x(i, 1) = "S" Then
                y(i, 1) = c(i, 1) + d(i, 1)
                j = j + 1
            Else
                y(i, 1) = "NULL"
                j = j + 1
            End If
        Next i
    Range("B1").Resize(UBound(y), 1).Value = y
End Sub

代码按照需要工作,但想知道声明多个范围的方法是否正确以及执行。

我必须循环100 000行

2 个答案:

答案 0 :(得分:1)

您可以将整个数据读入一个名为多维数组的数组。

根据您现有的代码,您可以尝试这样的事情......

Sub ANewMacro()
    Dim lr As Long, i As Long, j As Long
    Dim x, y()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    x = Range("A1:D" & lr).Value
    ReDim y(1 To UBound(x, 1), 1 To 1)
    j = 1
    For i = 1 To UBound(x, 1)
        If x(i, 1) = "L" Then
            y(i, 1) = x(i, 3) + x(i, 4)
        ElseIf x(i, 1) = "S" Then
            y(i, 1) = x(i, 3) + x(i, 4)
        Else
            y(i, 1) = "NULL"
        End If
        j = j + 1
    Next i
    Range("B1").Resize(UBound(y), 1).Value = y
End Sub

在上面的代码中,x(i,1)表示A列中的数据,x(i,3)表示C列中的数据,x(i,4)表示D列中的数据。

现在,因为如果A列是" L"或" S"你正在执行相同的计算,所以你可以像下面那样替换For循环......

For i = 1 To UBound(x, 1)
    If x(i, 1) = "L" Or x(i, 1) = "S" Then
        y(i, 1) = x(i, 3) + x(i, 4)
    Else
        y(i, 1) = "NULL"
    End If
    j = j + 1
Next i

答案 1 :(得分:0)

<强>&#34; F1&#34;是配方细胞。我相信你可以纠正。

Sub ANewMacro()
    Dim lr As Long, i As Long, j As Long
    Dim c, d, x, y()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    x = Range("A1:D" & lr).Value
    'c = Range("C1:C" & lr).Value
    'd = Range("D1:D" & lr).Value
        ReDim y(1 To UBound(x, 1), 1 To 1)
        j = 1
        For i = 1 To UBound(x, 1)
            If x(i, 1) = "Male" Then
                y(i, 1) = x(i, 3) + x(i, 4)
            Else
                y(i, 1) = False
            End If
        Next i
        Range("b1").Resize(UBound(y), 1).Value = y '<~~ "b1" your formula exist cell
End Sub