0

私は障害物にぶつかっていて、これを理解できません。

それぞれにヘッダーが付いた9列のシートがあります。これらの列のうち 2 つには、開始日と終了日があります。10 番目の列では、終了日を開始日で減算して日数を取得します。これらは、0 (1 日のみ) から 5 までの範囲です。

10 番目の列 (列 J) をチェックし、番号を参照して、そのすぐ下に行を挿入し、そこに含まれる情報も含む VBA コードを実行しようとしています。

行を追加して 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 に答える