VBA代码通过移动/移动单元格范围来覆盖单元格 [英] VBA code to overwrite cells through moving /shifting up a range of cells

问题描述

我有一个数据表，从图片可以看出，这是不时变化的。例如，如果在15月3日发布新数据，我将不得不将单元格从4月14日起复制到3月14日。此后，我将填写以前填写了feb'15信息的空白单元上的march'15信息。我想知道是否有任何vba代码帮助移动或移动范围到已经存在数据的单元格的首选行（更多的代码重叠/通过移动/转移覆盖单元格）。

正在考虑使用Activecell.offset，但我不知道它是否可以作为一系列单元格移动。 p>

解决方案

在这种情况下，使用简单的循环来复制值。最后一行（13）被第14行的空值覆盖。

  Public Sub MoveUp（）
 
 Dim sh As工作表
 Dim x As Long，y As Long 
 
设置sh = ActiveSheet或特定工作表
 
'12个月
对于y = 2到13 
'你的7列
对于x = 1到7 
 sh.Cells（y，x）= sh.Cells（y + 1，x）
下一个x 
下一个y 
 
带sh.Cells（13，1）
。选择
'只有在你的列A包含日期字符串）
 .Value = DateAdd（m，1，sh.Cells（12，1））
结束
 
 End Sub 
  

如果您的列A包含字符串，而不是日期，则删除DateAdd行。

Hi there i have a data table, as seen from the picture, which changes from time to time. For example if there new data coming up for March'15 i would have to copy and overlap cells from April'14 onwards to March'14. Thereafter i would fill in the information for march'15 on the blank cell that was previously filled with feb'15 information. I was wondering if there is any vba code to help move or shift the range to the preferred row of cells that already has existing data ( more of a code to overlap/ overwrrite cells through moving/shifting up) .

Was thinking of Activecell.offset but i am not sure if it can shift up as a range of cells.

解决方案

In that case, use a simple loop to copy the values. The last row (13) is overwritten with the empty values of row 14.

Public Sub MoveUp()

    Dim sh As Worksheet
    Dim x As Long, y As Long

    Set sh = ActiveSheet ' or the specific sheet

    ' The 12 months
    For y = 2 To 13
        ' Your 7 columns
        For x = 1 To 7
            sh.Cells(y, x) = sh.Cells(y + 1, x)
        Next x
    Next y

    With sh.Cells(13, 1)
        .Select
        ' This only works if your column A contains dates (not strings)
        .Value = DateAdd("m", 1, sh.Cells(12, 1))
    End With

End Sub

Remove the DateAdd line at the end if your column A contains strings, not dates.

这篇关于VBA代码通过移动/移动单元格范围来覆盖单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！