Question

我正在跑到路障，无法解决这个问题。

我有一张工作表，有9列，每列都有一个标题。其中2列具有开始日期和结束日期。第10列，我按开始日期减去结束日期以获得天数。这些可以是从0（仅1天）到5的任何地方。

我正在尝试执行VBA代码，该代码将检查第10列（列J）并引用该数字，在其下方插入一行并且还包含它包含的信息。

我有以下代码，使用添加的行将信息插入到Sheet2，并将数据向下复制到新行中。

但我遇到的问题是：

J3 = 4，然后在J3下插入4行并从A3：I3复制数据，但是，对于开始日期和结束日期，请输入适当的日期。

暗示，比如说开始日期是2013年1月1日，结束日期是2013年1月1日，那么

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

这可能吗？我知道我可以将这些数据导入Access并执行追加查询，但我的工作不喜欢我使用Access。

这是有关插入行并将数据从所有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

Answer 1

如果我理解正确，您的代码应该是这样的：

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

Answer 2

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

用于插入列和粘贴数据的VBA代码 - 更改日期值

2 个答案: