我有一个像这种格式的数据集:
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
答案 0 :(得分: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逐行逐步查看其工作原理!