1

Excel 2010 (Windows 7) 用の VBA スクリプトの作成についてサポートが必要です。

次のように設定された何千ものエントリがあります。

Data ID Number1 (A1)
Data Article Name1 (A2)
Data ID Number2 (A3)
Data Article Name2 (A4)
Data ID Number 3 (A5)
Data Article Name 3 (A6)
Data ID Number 3 (A7)
Data Article Name 3 (A8)

=============

そして、次のようにする必要があります。

Data ID Number1 (A1)     Data Article Name1 (B1)
Data ID Number2 (A2)     Data Article Name2 (B2)
Data ID Number 3 (A3)    Data Article Name3 (B3)
Data ID Number 4 (A4)    Data Article Name4 (B4)

大量のエントリがあるため、これを自動プロセスとして実行できるようにする必要があります。

記事を編集して、少しわかりやすくしました！

4

3 に答える 3

0

このコードは少し単純ですが、うまくいくはずです

Sub Shift()
'Set to your first value you want shifted. In your example A2.
Range("A2").Select

    Do

        ActiveCell.Cut
        ActiveCell.Offset(-1, 1).Select
        ActiveSheet.Paste
        ActiveCell.Offset(1, -1).Select
        ActiveCell.EntireRow.Select
        ActiveCell.Delete

    ActiveCell.Offset(1, 0).Select

    Loop Until ActiveCell.Value = "" And ActiveCell.Offset(-1, 0).Value = ""
End Sub

すてきな一日を！

于 2012-11-30T21:38:29.990 に答える
0

これは機能しますか？Article を含む元の行を削除したいかどうか、あなたの質問から確信が持てませんでした。

Dim row
Dim lastRow
lastRow = 8

For row = lastRow To 2 Step -1
    If row Mod 2 = 0 Then
        ' copy data
        Cells(row - 1, 2) = Cells(row, 1).Value
        ' delete row
        Cells(row, 1).EntireRow.Delete
    End If
Next
于 2012-11-30T19:21:04.810 に答える
0

このマクロは、列 A のすべてのセルを反復処理します。セル行が偶数の場合、値は列 B に ((-1,1 のオフセットで) 移動されます。次に、セルは次の範囲に追加されます。 For ループの完了後に削除されます。

Sub test()

    Dim i As Range
    Dim delrows As Range

    For Each i In Intersect(ActiveSheet.UsedRange, Range("A:A"))
        If (i.Row Mod 2) = 0 Then
            i.Offset(-1, 1).Value = i.Value

            If delrows Is Nothing Then
                Set delrows = i
            Else
                Set delrows = Union(i, delrows)
            End If
        End If
    Next i

    delrows.EntireRow.Delete


End Sub
于 2012-11-30T19:38:19.180 に答える