Question

我正在尝试自动化我的月度报告，我终于将我的脚趾浸入VBA（通过复制我在网上看到的一些东西，并试图让它与我的项目一起工作）。

我目前有一个宏在列A，H，O等中插入列。现在我想要另一个宏在每个宏中插入一个= CONCATENATE公式，然后用数据填充到最后一行（我将接着字符串这两个宏在一起）。

我目前有以下

Sub FillDown()
Dim strFormulas(1 To 5) As Variant
With ThisWorkbook.Worksheets("CommentsData")
    strFormulas(1) = "=CONCATENATE(B1,C1)"
    strFormulas(2) = "=CONCATENATE(I1,J1)"
    strFormulas(3) = "=CONCATENATE(P1,Q1)"
    strFormulas(4) = "=CONCATENATE(W1,X1)"
    strFormulas(5) = "=CONCATENATE(AD1,AE1)"
    .Range("A1,H1,O1,V1,AC1").Formula = strFormulas
    .Range("A1,H1,O1,V1,AC1").FillDown

    .Range("A:AG").NumberFormat = "General"
End With
End Sub

我得到一个运行时1004“Range类失败错误的Filldown方法，并且范围行被突出显示。我假设我试图引用多个不并排的列的方式存在问题（无法在网上找到这个例子。）

感谢任何帮助。

跟进问题;一旦我有了这个工作，我也想用工作簿中的其他工作表来完成它，但它将是不同的列。我是否需要创建一个新模块，或者我可以将代码再次粘贴到同一模块中并更改范围/单元格引用？如果是这样，我会复制/粘贴哪一部分

Answer 1

在这个具体示例中，您可以简化为：

Option Explicit

Public Sub FillDown1()
    Dim myColumns(), lastRow As Long, i As Long
    myColumns = Array("A", "H", "O", "V", "AC")

    With ThisWorkbook.Worksheets("CommentsData")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to

        For i = LBound(myColumns) To UBound(myColumns)
            .Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
        Next i
        .Range("A:AG").NumberFormat = "General"
    End With
End Sub

离你更近的东西，但男孩看起来很难看：

Public Sub FillDown2()
    Dim myColumns(), lastRow As Long, i As Long, myFormulas(1 To 5) As Variant
    myColumns = Array("A", "H", "O", "V", "AC")
    myFormulas(1) = ("B,C")
    myFormulas(2) = ("I,J")
    myFormulas(3) = ("P,Q")
    myFormulas(4) = ("W,X")
    myFormulas(5) = ("AD,AE")

    If UBound(myColumns) + 1 <> UBound(myFormulas) Then MsgBox "Array length for myColumns doesn't match myFormulas": Exit Sub

    With ThisWorkbook.Worksheets("CommentsData")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to
        For i = LBound(myColumns) To UBound(myColumns)
            .Cells(1, myColumns(i)).Formula = "=CONCATENATE(" & Split(myFormulas(i + 1), ",")(0) & 1 & "," & Split(myFormulas(i + 1), ",")(1) & 1 & ")"
            .Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FillDown
        Next i
        .Range("A:AG").NumberFormat = "General"
    End With
End Sub

你甚至可以将行（1）移回到myFormulas数组

Public Sub FillDown2()
    Dim myColumns(), lastRow As Long, i As Long, myFormulas(1 To 5) As Variant
    myColumns = Array("A", "H", "O", "V", "AC")
    myFormulas(1) = ("B1,C1")   '<==========================shifted row back up into array
    myFormulas(2) = ("I1,J1")
    myFormulas(3) = ("P1,Q1")
    myFormulas(4) = ("W1,X1")
    myFormulas(5) = ("AD1,AE1")

    If UBound(myColumns) + 1 <> UBound(myFormulas) Then MsgBox "Array length for myColumns doesn't match myFormulas": Exit Sub

    With ThisWorkbook.Worksheets("CommentsData")
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).row 'Change this to a column which you can use to determine how far to add formulas to
        For i = LBound(myColumns) To UBound(myColumns)
            .Cells(1, myColumns(i)).Formula = "=CONCATENATE(" & Split(myFormulas(i + 1), ",")(0) & "," & Split(myFormulas(i + 1), ",")(1) & ")"
            .Range(.Cells(1, myColumns(i)), .Cells(lastRow, myColumns(i))).FillDown
        Next i
        .Range("A:AG").NumberFormat = "General"
    End With
End Sub

Answer 2

你可以试试这个：

Sub FillDown()
    With ThisWorkbook.Worksheets("CommentsData")
        .Range("A:A,H:H,O:O,V:V,AC:AC").Offset(, 1).SpecialCells(xlCellTypeConstants).Offset(, -1).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
        .Range("A:AG").NumberFormat = "General"
    End With
End Sub

将其扩展到更多工作表：

Sub FillDownMoreSheets()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets(Array("CommentsData", "CommentsData2", "CommentsData3"))
        With ws
            .Range("A:A,H:H,O:O,V:V,AC:AC").Offset(, 1).SpecialCells(xlCellTypeConstants).Offset(, -1).FormulaR1C1 = "=CONCATENATE(RC[1],RC[2])"
            .Range("A:AG").NumberFormat = "General"
        End With
    Next
End Sub

Answer 3

您应避免使用保留字

命名Subs，Functions和变量

FillDown会隐藏内置的 Range.FillDown Method

这将适用于顶部常量中定义的所有工作表

WS_RANGES中的列表由空格分隔，并包含

的子列表

SheetName-Range-ColumnOffset（CommentsData-A1:AG-7）
ColumnOffset必须为3或更大（对于公式）

Option Explicit

Public Sub JoinColumns()

 Const WS_RANGES = "CommentsData-A1:AG-7 CommentsData2-C2:AX-3"  'WSNames-Range-Offset

 Dim wsSet As Variant, ws As Worksheet, ur As Range, cls As Range, i As Variant, c As Long

 wsSet = Split(WS_RANGES)

 For Each ws In ThisWorkbook.Worksheets
   For Each i In wsSet
    i = Split(i, "-")

    If ws.Name = i(0) Then
     Set ur = ws.Range(i(1) & ws.Cells(ws.Rows.Count, Split(i(1),":")(1)).End(xlUp).Row)

     Set cls = ur.Columns(1)
     For c = i(2) + 1 To ur.Columns.Count Step i(2)
      Set cls = Union(cls, ur.Columns(c))
     Next
     cls.Formula = "=RC[1] & RC[2]"

     ur.NumberFormat = "General"
     Exit For
   End If
  Next
 Next
End Sub

VBA将公式添加到特定列并填充到最后一行

3 个答案: