插入列和粘贴数据的 VBA 代码 - 更改日期值
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14408467/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Code to Insert Column and Paste Data - changing Date Value
提问by Rahul P
I am running in to a road block and unable to figure this out.
我遇到了路障，无法弄清楚这一点。
I have a sheet, which has 9 columns, each with a header. 2 of those columns have a start date and end date. The 10th column, I subtract End Date by Start Date to get the number of days. These could be anywhere from 0 (only 1 day) to 5.
我有一张工作表，它有 9 列，每列都有一个标题。其中 2 列具有开始日期和结束日期。第 10 列，我用开始日期减去结束日期以获得天数。这些可以是从 0（仅 1 天）到 5 的任何地方。
I am trying to do a VBA code, that would check the 10th column (Column J) and referencing to the number, insert a row right under it and also have the information that it contains.
我正在尝试编写一个 VBA 代码，该代码将检查第 10 列（J 列）并引用该数字，在其正下方插入一行并包含其中包含的信息。
I have the following code that inserts the information to Sheet2 with the added Rows and copies the data down in the new rows.
我有以下代码将信息插入到带有添加行的 Sheet2 中，并将数据复制到新行中。
But the issue I am having is this:
但我遇到的问题是：
J3 = 4, then insert 4 rows under J3 and copy data from A3:I3, except, for the Start Date and End Date, put the appropriate date.
J3 = 4，然后在J3下插入4行，从A3:I3复制数据，除了Start Date和End Date，输入合适的日期。
Implying, say the Start Date is 1/1/2013 and End Date is 1/4/2013, then put
暗示，假设开始日期是 1/1/2013，结束日期是 1/4/2013，然后把
Sdate Edate
1/1/2013 1/4/2013
1/2/2013 1/2/2013
1/3/2013 1/3/2013
1/4/2013 1/4/2013
Could this be possible? I know I could import this data to Access and do an Append Query, but my work does not like me to use Access.
这可能吗？我知道我可以将这些数据导入 Access 并执行追加查询，但我的工作不喜欢我使用 Access。
This is the code that works with regards to inserting the rows and copying the data from all 10 columns to the new ones:
这是用于插入行并将数据从所有 10 列复制到新列的代码：
Option Explicit
Sub BuildSortedSht()
Dim sht As Worksheet
Dim rng As Range
Dim IP As Range
Dim LastRow As Integer
Dim i As Integer
Dim scell As Variant
LastRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
Set sht = Application.ThisWorkbook.Worksheets("Sheet2")
Set rng = Sheets("Sheet1").Range("J2:J" & LastRow)
Set IP = sht.Range("A2")
For Each scell In rng
If scell > 1 Then
For i = 1 To scell
Range(scell.Offset(0, -9), scell.Offset(0, 1)).Copy
IP.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:= False, Transpose:=False
Set IP = IP.Offset(1, 0)
Next i
Else
Range(scell.Offset(0, -9), scell.Offset(0, 1)).Copy
IP.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:= False, Transpose:=False
Set IP = IP.Offset(1, 0)
End If
Next
End Sub
采纳答案by user3408104
Dim MyDate As Date
Dim LastRow As Long
Dim i As Long
Dim j As Long
With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1 'as you insert new rows that shift data, you have to go in a loop up: from bottom to top
If .Cells(i, "J") > 0 Then
.Rows(i + 1 & ":" & i + .Cells(i, "J")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'copy range(s) you want from row above
.Range(.Cells(i + 1, "A"), .Cells(i + .Cells(i, "J"), "I")).Value = .Range(.Cells(i, "A"), .Cells(i, "I")).Value
'create start:end dates in columns A:B (A = start date)
MyDate = .Cells(i, "A")
For j = i + 1 To i + .Cells(i, "J")
MyDate = DateAdd("d", 1, MyDate)
.Range(.Cells(j, "A"), .Cells(j, "B")) = MyDate
Next j
End If
Next i
End With
回答by mj82
If I understand you correctly, your code should be like this:
如果我理解正确的话，你的代码应该是这样的：
Dim MyDate As Date
Dim LastRow As Long
Dim i As Long
Dim j As Long
With Sheets("Sheet1")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1 'as you insert new rows that shift data, you have to go in a loop up: from bottom to top
If .Cells(i, "J") > 0 Then
.Rows(i + 1 & ":" & i + .Cells(i, "J")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'copy range(s) you want from row above
.Range(.Cells(i + 1, "A"), .Cells(i + .Cells(i, "J"), "I")).Value = .Range(.Cells(i, "A"), .Cells(i, "I")).Value
'create start:end dates in columns A:B (A = start date)
MyDate = .Cells(i, "A")
For j = i + 1 To i + .Cells(i, "J")
MyDate = DateAdd("d", 1, MyDate)
.Range(.Cells(j, "A"), .Cells(j, "B")) = MyDate
Next j
End If
Next i
End With
