[已解决]（急求大师帮忙）用VBA或者公式皆可

as0810114 · 发表于 2013-4-10 14:40

具体要求见附件，麻烦各位老师帮忙，谢谢。

最佳答案

hwc2ycy

2013-4-10 15:18

Sub 分类复制()
Worksheets("sheet1").Copy after:=Worksheets(Worksheets.Count)
Dim lRow As Long, lCopyNumber As Byte
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For lRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
lCopyNumber = Cells(lRow, "f")
Rows(lRow).Copy
Rows(lRow).Resize(lCopyNumber - 1).Insert
Cells(lRow, "f") = 1
Cells(lRow, "f").AutoFill Range(Cells(lRow, "f"), Cells(lRow + lCopyNumber - 1, "f")), xlLinearTrend
Next
Application.ScreenUpdating = True
MsgBox "数据行复制完成" & vbNewLine & _
"新数据在工作表 " & ActiveSheet.Name
End Sub

复制代码

hwc2ycy · 发表于 2013-4-10 15:18

Sub 分类复制()
Worksheets("sheet1").Copy after:=Worksheets(Worksheets.Count)
Dim lRow As Long, lCopyNumber As Byte
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For lRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
lCopyNumber = Cells(lRow, "f")
Rows(lRow).Copy
Rows(lRow).Resize(lCopyNumber - 1).Insert
Cells(lRow, "f") = 1
Cells(lRow, "f").AutoFill Range(Cells(lRow, "f"), Cells(lRow + lCopyNumber - 1, "f")), xlLinearTrend
Next
Application.ScreenUpdating = True
MsgBox "数据行复制完成" & vbNewLine & _
"新数据在工作表 " & ActiveSheet.Name
End Sub

复制代码

wayy · 发表于 2013-4-10 15:21

急求.rar (13.23 KB, 下载次数: 10)

尛ぃ謉 · 发表于 2013-4-10 15:29

本帖最后由尛ぃ謉于 2013-4-10 15:45 编辑

用函数做说明是说N-1行模拟结果却是N行所以按照模拟结果的
也不清楚是否正确

改下公式

=IF(AND(COLUMN(A1)<7,ROW(A1)<SUM($F$2:$F$15)+1),IF(COLUMN(A1)<6,INDEX(A$2:A$15,ROWS(1:14)-MATCH(ROW(A1),LARGE(SUBTOTAL(9,OFFSET($F$2,,,ROW($1:$14))),ROW($1:$14)),-1)+1)&"",COUNTIF(OFFSET($A$1,ROW()-ROW(A1),COLUMN()-4,ROW(A1)),T(OFFSET($A$1,ROW()-1,COLUMN()-4)))),"")

复制代码

数组公式

1032446692 · 发表于 2013-4-10 15:35

你看看吧

		自动登录	找回密码
密码			注册