每 n 行自动填充

Question

如何根据 A 列自动填充整个 B 列，但每个字母之间有 n 个空行？

Column A:

a
b
c

Column B:

a
...
...
b
...
...
c

我试过下面的 VBA 代码：

Range("A1:A3").AutoFill Destination:=Range("A1:A10"), Type:=xlFillDefault

该代码适用于数字，但当单元格引用公式（在本例中为 =A1，...）时无效，因为代码似乎引用了公式所在的行，而不是中的列表A 列

例如，代码在 B7 中的 c 之后插入了一行公式，但是会插入 =A7 而不是 =A4，这将是字母 d.

如有任何帮助，我们将不胜感激。

Answer 1

要为 A 列中的每个值插入 n row，我将使用 offset 来解决它，这里是解决方案，希望您觉得它有用：

Sub ty()

Dim count As Long, i As Long, nextrow As Long

count = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
nextrow = 1

For i = 1 To count
    Sheet1.Cells(nextrow, 2).Value = Sheet1.Cells(i, 1).Value
    nextrow = Cells(nextrow, 2).Offset(3, 1).Row
Next

End Sub

预期输出：

为了将公式保存到新的单元格中，您可能需要 copy 方法，方法是更改此部分：

For i = 1 To count
    Sheet1.Cells(i, 1).Copy Sheet1.Cells(nextrow, 2)
    nextrow = nextrow + 3
Next

Answer 2

每 n 行自动填充

你运行GetGappedColumnTEST。 GetGappedColumn 正在被 GetGappedColumnTEST 调用。
调整常量部分和工作簿中的值，并适当重命名 Sub。

Option Explicit

Sub GetGappedColumnTEST()
    
    Const sName As String = "Sheet1"
    Const sFirst As String = "A1"
    
    Const dName As String = "Sheet1"
    Const dFirst As String = "B1"
    Const dGap As Long = 2

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim Data As Variant
    Data = GetGappedColumn(wb.Worksheets(sName).Range(sFirst), dGap)
    
    If IsEmpty(Data) Then Exit Sub
    
    Dim drCount As Long: drCount = UBound(Data, 1)
    
    With wb.Worksheets(dName).Range(dFirst)
        .Resize(drCount).Value = Data
        .Resize(.Worksheet.Rows.Count - .Row - drCount + 1) _
            .Offset(drCount).ClearContents
    End With
    
End Sub

Function GetGappedColumn( _
    ByVal FirstCell As Range, _
    Optional ByVal Gap As Long = 0) _
As Variant
    Const ProcName As String = "GetGappedColumn"
    On Error GoTo clearError

    If FirstCell Is Nothing Then Exit Function
    If Gap < 0 Then Exit Function
    
    Dim srg As Range
    With FirstCell.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set srg = .Resize(lCell.Row - .Row + 1)
    End With
    Dim rCount As Long: rCount = srg.Rows.Count
       
    Dim sData As Variant
    If rCount = 1 Then
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
    Else
        sData = srg.Value
    End If
    
    Dim dData As Variant: ReDim dData(1 To rCount + rCount * Gap - Gap, 1 To 1)
    Dim d As Long: d = 1
    Dim s As Long
    For s = 1 To rCount - 1
        dData(d, 1) = sData(s, 1)
        d = d + 1 + Gap
    Next s
    dData(d, 1) = sData(s, 1)

    GetGappedColumn = dData
    
ProcExit:
    Exit Function
clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit
End Function

每 n 行自动填充

Autofill every n rows

excel

vba

autofill

每 n 行自动填充