使用数组填充相邻单元格

时间:2016-03-17 13:02:09

标签: excel vba excel-vba

我有一个工作表,其中每个其他列都填充了数字1-9,从不同的行开始。我编写了以下子来填充"测试[编号]"在每列中填充单元格右侧的单元格中。

我遇到了两个我无法弄清楚的问题。请参阅下面的屏幕截图,了解示例之前和之后的内容。

1。 H列的值从第1行开始,但代码在第2行开始填充

2。没有得到的"测试[编号]"细胞越过第9行

代码:

Sub test()

Dim i As Long
Dim j As Long
Dim c As Long
Dim r As Long
Dim rng As Range
Dim crng As Range
Dim carr() As Variant
Dim rarr() As Variant

With ThisWorkbook.ActiveSheet
c = .Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column
For j = 1 To c
If Not Columns(j).Find(what:="*", after:=Columns(j).Cells(1, 1), LookIn:=xlValues) Is Nothing And Columns(j).Find(what:="test", after:=Columns(j).Cells(1, 1), LookIn:=xlValues) Is Nothing Then
    r = Columns(j).Find(what:="*", after:=Columns(j).Cells(1, 1), LookIn:=xlValues).Row
    Set rng = .Range(.Cells(r, j), .Cells(.Rows.Count, j).End(xlUp))
    rarr = rng.Value
For i = r To UBound(rarr, 1)
    Cells(i, j + 1).Value = "test " & (i - r) + 1
Next i
End If
Next j

End With

End Sub

在: enter image description here

在: enter image description here

期望的结果: enter image description here

我在我的代码中使用数组很新,所以如果我的方法关闭,我不会感到惊讶。话虽如此,我很难说UBound(rarr,1) = rng.Range(.Cells(r, j), .Cells(.Rows.Count, j).End(xlUp))没有返回最后一个单元格。

感谢任何帮助或建议。

由于

2 个答案:

答案 0 :(得分:2)

H列从第2行开始,因为您要求automated reference counting启动after:=Columns(j).Cells(1, 1)。我已将其更改为在列中的最后一个单元格之后开始,以便它循环回到顶部。

UBound(rarr,1)是数组的上边界。 Range.Find methodLBound函数返回下边界和上边界或数组。它是'rng中的'位置,而不是工作表上的实际行。

Sub test()

    Dim i As Long
    Dim j As Long
    Dim lc As Long
    Dim lr As Long
    Dim r As Long
    Dim rng As Range
    Dim crng As Range
    Dim carr() As Variant
    Dim rarr() As Variant

    With ThisWorkbook.ActiveSheet
        lc = .Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column
        lr = .Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
        For j = 2 To lc Step 2
            If CBool(Application.CountA(.Columns(j))) Then
                r = .Columns(j).Find(what:="*", after:=.Cells(lr, j), LookIn:=xlValues).Row
                Set rng = .Range(.Cells(r, j), .Cells(.Rows.Count, j).End(xlUp))
                rarr = rng.Value
                For i = LBound(rarr, 1) To UBound(rarr, 1)
                    .Cells(i + (r - 1), j + 1).Value = "test " & i
                Next i
            End If
        Next j
    End With

End Sub

虽然您已经实现了UBound,但在整个代码中并未使用它来表示父工作表。 With ... End With statementRange.CellsRange objects中的每一个都必须使用前缀.才能继承Range.Columns工作表property.reference。

答案 1 :(得分:0)

作为所有这些常数(数字),我建议让Excel为我们工作......

    Option Explicit

    Sub test()

        With ActiveSheet.Cells.SpecialCells(xlCellTypeConstants).Offset(, 1)
            .FormulaR1C1 = "=CONCATENATE(" & """" & "test" & """" & "&" & "COUNT(R1C[-1]:RC[-1]))"
            .Value = .Value
        End With

    End Sub