Question

我想复制以下四个公式并将其粘贴到相邻的四列中，每次列参考更改为四。我的意思是复制F4：I4并粘贴到J4：M4，N4：Q4 ......“F”换成“J”，然后是“N”，然后是“Q”，依此类推，直到结束工作表中的列。

=IF(AND(F2>=$C$4,F2<=$D$4),TRUE, FALSE)
=IF(AND((F2+6)>=$C$4,(F2+6)<=$D$4),TRUE,FALSE)
=IF(AND((F2+12)>=$C$4,(F2+12)<=$D$4),TRUE,FALSE)
=IF(AND((F2+18)>=$C$4,(F2+18)<=$D$4),TRUE,FALSE)

我是否可以通过某种方式循环遍历每一列，并在第四列之后将4添加到单元格引用的数值？所以代替F2和J2我有Col_ID，Col_ID + 4 ...不知道如何在VBA中写这个。任何帮助将不胜感激。

我用它来合并上面的每四个单元格来制作“标签”，我想我可以重复使用它但不确定如何。

Dim Rng As Range
Dim ws As Worksheet
Dim R1 As Long, C1 As Long
Dim R2 As Long, C2 As Long
Dim lastCol As Long

Set ws = ThisWorkbook.Sheets("Dashboard")

R1 = 3: C1 = 6
R2 = 3: C2 = C1 + 3

lastCol = 1

While lastCol < 256
    With ws
        Set Rng = .Range(.Cells(R1, C1), .Cells(R2, C2))
        Application.DisplayAlerts = False
        Rng.Merge
        Application.DisplayAlerts = True
        C1 = C2 + 1
        C2 = C1 + 3
        lastCol = lastCol + 1
    End With
Wend

Answer 1

这会将源范围复制到您使用NumberOfCopies指定的任意多个四列组。你没有说你要复制的范围，所以我假设G3：J3：

Sub CopyCols()
Dim rngSource As Excel.Range
Dim rngTarget As Excel.Range
Dim NumberOfCopies As Long

NumberOfCopies = 12
With ActiveSheet
    Set rngSource = .Range("G3:J3")
    Set rngTarget = .Range("K3").Resize(rngSource.Rows.Count, NumberOfCopies * 4)
    rngSource.Copy Destination:=rngTarget
End With
End Sub

每隔四列粘贴公式，向列引用添加四个

1 个答案: