0

我遇到了路障，无法弄清楚。

我有一张表，它有 9 列，每列都有一个标题。其中 2 列有开始日期和结束日期。第 10 列，我用开始日期减去结束日期得到天数。这些可能是从 0（仅 1 天）到 5 的任何值。

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

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

但我遇到的问题是：

J3 = 4，然后在 J3 下插入 4 行并从 A3:I3 复制数据，除了开始日期和结束日期，输入适当的日期。

暗示，假设开始日期是 2013 年 1 月 1 日，结束日期是 2013 年 1 月 4 日，然后放

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
4

2 回答 2

0

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

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
于 2013-01-18T23:05:53.327 回答
0 
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
于 2014-03-11T21:41:11.320 回答