0

私はこの形式のようなデータセットを持っています:

 varname  Flag  Status
Product1    Y   
Product2    N   
Product3    N   
Product4    N   
Product5    N   
Product6    N   
Product7    Y   
Product8    Y   
Product9    Y   
Product10   Y

ここで、製品フラグが「Y」の場合、そのすぐ隣の行に入力し、その行をコピーしてすぐにその行の下に貼り付ける必要があります。新しいテーブルは次のようになります。

varname   Flag  Status
Product1    Y   
Product1    Y   SOLD
Product2    N   
Product3    N   
Product4    N   
Product5    N   
Product6    N   
Product7    Y   
Product7    Y   SOLD
Product8    Y   
Product8    Y   SOLD
Product9    Y   
Product9    Y   SOLD
Product10   Y   
Product10   Y   SOLD

このステータスも更新する必要があります。次のコードを試しました。残念ながら、このコードではテーブルを作成できませんでした。誰かが解決策を見つけるのを手伝ってくれたら、私は感謝します。

Sub RegInt2()
    Dim lngRow As Long
    Dim LR As Long
    For lngRow = Worksheets("Sheet1").UsedRange.Rows.Count To 1 Step -1
          LR = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
        If UCase$(Worksheets("Sheet1").Cells(lngRow, 2).Value) = "R" Then
            Worksheets("Sheet1").Range("A" & CStr(lngRow + 1)).Select
            Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            End If
            If UCase$(Worksheets("Sheet1").Cells(lngRow, 2).Value) = "R" Then
            Worksheets("Sheet1").Range("A" & LR).Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)


        End If
        Next

End Sub
4

1 に答える 1

3

これはどう？

Sub DuplicateSoldProducts()

Dim ProductRange As Range
Dim ProductCell As Range

Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet

'create a new worksheet
Set SourceSheet = Worksheets("Products")
Set TargetSheet = Worksheets.Add

SourceSheet.Select
Range("A1").Select

'put in titles
Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
TargetSheet.Select
TargetSheet.Paste

SourceSheet.Select
Application.CutCopyMode = False

'set reference to block of products
Set ProductRange = Range(ActiveCell, ActiveCell.End(xlDown))

'go through product by product
For Each ProductCell In ProductRange.Cells

    'create row (and maybe copy) on target sheet
    TargetSheet.Select
    ActiveCell.Value = ProductCell.Value
    ActiveCell.Offset(0, 1).Value = ProductCell.Offset(0, 1).Value

    'go to next cell
    ActiveCell.Offset(1, 0).Select

    If UCase(ProductCell.Offset(0, 1).Value) = "Y" Then

        'create copy?
        ActiveCell.Value = ProductCell.Value
        ActiveCell.Offset(0, 1).Value = ProductCell.Offset(0, 1).Value
        ActiveCell.Offset(0, 2).Value = "Sold"

        'go to next cell
        ActiveCell.Offset(1, 0).Select

   End If

Next ProductCell

Range("A1").CurrentRegion.EntireColumn.AutoFit
Range("A1").Select

MsgBox "Done!"

F8 を押して行ごとにステップスルーし、どのように機能するかを確認してください!

于 2012-11-15T16:24:11.990 に答える