Question

我正在使用以下内容，但在循环期间选择实际单元格有困难。它正在拉动一系列细胞，检查它们的值是否> 0然后如果是，应该向右添加3列。这就是我到目前为止所做的，不确定它的效率如何：

    Dim varray As Variant
    Dim x As Long

    varray = Range("E13:AK13").Value

    For x = UBound(varray, 1) To LBound(varray, 1) Step -1
        If varray(x, 1) > 0 Then

            varray(x, 1).Activate 'ISSUE ON THIS LINE
            ActiveCell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
            ActiveCell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
            ActiveCell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
            'substract 2
        End If
    Next

Answer 1

请尝试这样做。

Dim x As Long, rng As Range

Set rng = Range("E13:AK13")

For Each cell In rng
    If cell > 0 Then
        cell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
        cell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
        cell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
    End If
Next cell

Answer 2

当您使用数组时，选择预期的单元格将非常困难。我对代码做了一些修改，检查它是否适合你。

Dim varray As Range
Dim x As Long

Set varray = Range("E13:AK13") 

''For x = UBound(varray, 1) To LBound(varray, 1) Step -1
For Each c In varray
    If c.Value > 0 Then

        c.Select 'ISSUE ON THIS LINE
        ActiveCell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
        ActiveCell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
        ActiveCell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
        'substract 2
    End If
Next c

如果单元格包含值，则VBA添加列

2 个答案: