excel - 使用VBA自动将内容复制到excel中的单元格范围

Question

下面是我最初的excel表

下面是我的输出应该是什么

我的做法：

• 从 A 列获取第一个值

  获取 A 列的偏移量（0,1）（结果为 B1）

  获取从 B 列到第一个空单元格的记录数（结果为 3）将 A1 的值复制到 A1 下方的单元格（记录数 - 1）

• 循环 A 列中的所有 3 个值

我已经实现，直到我得到 A 列中值的单元格的地址。下面是我的代码。

  Dim currentRow As Integer
  Dim element As Variant
  Dim totalRows As String
  Dim offsetrow As String
  Dim offsetcell As Variant

  totalRows = Range("A" & ActiveSheet.Rows.Count).End(xlUp).row
  MsgBox (totalRows)


  For currentRow = 1 To totalRows
    If (IsEmpty(Cells(currentRow, 1).Value)) Then

    Else
        Cells(currentRow, 1).Select
        offsetcell = ActiveCell.Offset(0, 1).Address

        'Do the rest
    End If
  Next

End Sub

任何帮助表示赞赏

Answer 1

您可以通过使用数组来优化它，但这是基本思想：

Dim i As Long

For i = 1 To ActiveSheet.UsedRange.Rows.Count
    If Cells(i + 1, 1).Value = "" And Cells(i, 1).Value <> "" And Cells(i + 1, 2).Value <> "" Then
        Cells(i + 1, 1).Value = Cells(i, 1).Value
    End If
Next

Answer 2

只是一个替代解决方案：

要准确确定您的范围的行数：

Lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

解决您的问题的另一种方法：

手动的

1. 在 a 列中选择范围，
2. 转到空白处（ctrl+g），
3. 按 =，向上箭头。现在按住 ctrl+Enter
4. 复制/粘贴为值...

这是执行此操作的代码片段：

Lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Range("A1:A" & Lastrow).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
Range("A1:A" & Lastrow).Value = Range("A1:A" & Lastrow).Value

最后循环遍历列 B 并删除 B 为空白的 A 值。

希望这可以帮助。

Answer 3

这是我实现所需输出的解决方法。这可能不是最有效的方法。无论如何它有效:)。

Sub Button1_Click()

  Dim currentRow As Integer
  Dim totalrows As String
  Dim offsetrow As Integer
  Dim i As Integer
  Dim row As Integer


  totalrows = Range("A" & ActiveSheet.Rows.Count).End(xlUp).row


  For currentRow = 1 To totalrows
    If (IsEmpty(Cells(currentRow, 1).Value)) Then

    Else
        Cells(currentRow, 1).Select
        offsetrow = ActiveCell.Offset(0, 1).row

        row = offsetrow

        i = 1
        Do While (Cells(row, 2).Value <> "")
            i = i + 1
            row = row + 1
            Cells((row - 1), 1).Value = Cells(currentRow, 1).Value

        Loop

    End If
  Next

End Sub

希望这对遇到同样问题的人有所帮助。