2

このようなデータがあるとします

  A   B   C
1 Jim 1 10    
2 Jim 2 20
3 Jim 3 30
4 Tom 1 20
5 
6 
7 Jos 1 15
8
9

私が望むのは、行 2 と 3 をコピーしてから、行 5 と 6、次に 8 と 9 などに貼り付けることです。空白行は常に 2 です。

セル 2C と 3C には、セル C1 を掛けた列 B の値を計算する数式があります。

というわけで、結果はこのようになります

  A   B   C
1 Jim 1 10    
2 Jim 2 20
3 Jim 3 30
4 Tom 1 20
5 Tom 2 40 
6 Tom 3 60
7 Jos 1 15
8 Jos 2 30
9 Jos 3 45

問題は、時間がかかる何百回も貼り付けなければならないことです。

誰か助けていただければ幸いです。

4

2 に答える 2

0

注意してください:

  • 列 A1 に値があることを確認する必要があります。それ以外の場合はi、データのある 2 行目に値を増やしてください。

  • Var新しい名前が発生したときに追跡するために使用されるダミー変数です。

  • firstValue名前ごとに最初の行の行番号が含まれます。

コード

Sub test()

Var = 0
LastRow = Cells(Rows.Count, "A").End(xlUp).Row + 2

For i = 2 To LastRow
    If Range("A" & i).Value = "" Then
        If Var = 0 Then
            firstValue = i - 1
            Range("A" & i).Value = Range("A" & i - 1).Value
            Range("B" & i).Value = Range("B" & i - 1).Value + 1
            Range("C" & i).Value = Range("C" & firstValue).Value + Range("C" & i - 1).Value
            Var = Var + 1
        Else
            Range("A" & i).Value = Range("A" & i - 1).Value
            Range("B" & i).Value = Range("B" & i - 1).Value + 1
            Range("C" & i).Value = Range("C" & firstValue).Value + Range("C" & i - 1).Value
            Var = Var + 1
        End If
    Else
        Var = 0
    End If
Next i

End Sub
于 2012-11-16T10:46:16.643 に答える
0 
Sub MakeRows()
    Dim Sh As Worksheet, DataRng As Range, CopyRng As Range, TargetRng As Range

    Set Sh = Sheets(1) 'select your sheet here
                       'you can also do it like this = Worksheets("name")

    Set DataRng = Sh.Range("B2")
    Set TargetRng = Sh.Range("A4")

    While IsEmpty(TargetRng) = False
       TargetRng.Copy TargetRng.Offset(1, 0)
       TargetRng.Copy TargetRng.Offset(2, 0)

       Set CopyRng = Sh.Range(DataRng, DataRng.Offset(1, 1))
       CopyRng.Copy TargetRng.Offset(1, 1)

       Set TargetRng = TargetRng.Offset(3, 0)
       Set DataRng = DataRng.Offset(3, 0)
    Wend
End Sub

セル 2C および 3C の相対参照で動作します。

于 2012-11-16T08:34:48.823 に答える