Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

数据透视表40+个常用小技巧,让你一次学会!
查看: 377|回复: 10

[已解决]怎样实现按数拆行?

[复制链接]
发表于 2022-1-19 22:32 | 显示全部楼层 |阅读模式
目标.png 结果.png
如上图所示,怎么按照姓名后面对应的次数增加新的行呢,新手上路,录了个宏只能勉强看懂,不知是道怎么改成一个动态的,求大神指导下。
最佳答案
2022-1-20 08:12
請測試看看,謝謝
Sub test()
Dim Arr, Brr(1 To 10000, 1 To 2), i&, i2%
Arr = Sheets(1).[a1].CurrentRegion
For i = 2 To UBound(Arr): For i2 = 1 To Arr(i, 2)
    n = n + 1: Brr(n, 1) = Arr(i, 1): Brr(n, 2) = 1
Next i2: Next i
Sheets(2).[a2:a10000] = ""
Sheets(2).[a2].Resize(n, 2) = Brr
End Sub


excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2022-1-20 06:03 | 显示全部楼层
但愿能帮助到你!
Sub byWanao()
    Dim i%, j%, endRow%, endNum%, endRow2%
    endRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    Sheet2.Range("A2:B200").ClearContents
    For i = 2 To endRow
        endNum = Sheet1.Cells(i, 2)
        For j = 1 To endNum
            endRow2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Sheet2.Cells(endRow2, 1) = Sheet1.Cells(i, 1)
            Sheet2.Cells(endRow2, 2) = 1
        Next
    Next
End Sub
回复

使用道具 举报

发表于 2022-1-20 08:12 | 显示全部楼层    本楼为最佳答案   
請測試看看,謝謝
Sub test()
Dim Arr, Brr(1 To 10000, 1 To 2), i&, i2%
Arr = Sheets(1).[a1].CurrentRegion
For i = 2 To UBound(Arr): For i2 = 1 To Arr(i, 2)
    n = n + 1: Brr(n, 1) = Arr(i, 1): Brr(n, 2) = 1
Next i2: Next i
Sheets(2).[a2:a10000] = ""
Sheets(2).[a2].Resize(n, 2) = Brr
End Sub


1.JPG
回复

使用道具 举报

发表于 2022-1-20 09:02 | 显示全部楼层
Public Sub RowInsert()
Dim i As Integer
Dim countRow As Integer
Dim RowNum As Integer
Range("a1").CurrentRegion.Select
countRow = Selection.Rows.Count
i = 2
Do Until Cells(i, 2) = ""
RowNum = Cells(i, 2)
If RowNum <> 1 Then
Cells(i + 1, 1).EntireRow.Select
Selection.Resize(RowNum - 1).Insert
Range(Cells(i + 1, 1), Cells(i + RowNum - 1, 1)) = Cells(i, 1)
Range(Cells(i, 2), Cells(i + RowNum - 1, 2)) = 1
i = i + RowNum
Else
i = i + 1
End If
Loop
End Sub
回复

使用道具 举报

发表于 2022-1-20 10:54 | 显示全部楼层
D2{=OFFSET(A$1,SMALL(IF(B$2:B$5>=COLUMN(A:Z),ROW($1:$4),99),ROW(A1)),)&""
9452.png
回复

使用道具 举报

 楼主| 发表于 2022-1-20 10:58 | 显示全部楼层
wanao2008 发表于 2022-1-20 06:03
但愿能帮助到你!
Sub byWanao()
    Dim i%, j%, endRow%, endNum%, endRow2%

十分感谢回复,可以实现目标效果,对我理解循环很有帮助。二楼用的方法速度要更快些,最佳答案就给他啦。其实你的答案对我而言倒要好理解些。
回复

使用道具 举报

 楼主| 发表于 2022-1-20 11:00 | 显示全部楼层
Yunyun123 发表于 2022-1-20 09:02
Public Sub RowInsert()
Dim i As Integer
Dim countRow As Integer

这个也可以实现目标效果,又学到了一种思路,哈哈,感谢回复。
回复

使用道具 举报

 楼主| 发表于 2022-1-20 11:01 | 显示全部楼层
hcm19522 发表于 2022-1-20 10:54
D2{=OFFSET(A$1,SMALL(IF(B$2:B$5>=COLUMN(A:Z),ROW($1:$4),99),ROW(A1)),)&""

函数也可以解,高手,学习了。
回复

使用道具 举报

发表于 2022-1-20 19:25 | 显示全部楼层
不信这样还重名 发表于 2022-1-20 10:58
十分感谢回复,可以实现目标效果,对我理解循环很有帮助。二楼用的方法速度要更快些,最佳答案就给他啦。 ...

其实我用你的问题录制了一段视频:
全实例学VBA-41-怎样实现按数拆行 - wanao.梦田的视频 - 知乎https://www.zhihu.com/zvideo/1467382490628931584
回复

使用道具 举报

发表于 2022-1-20 20:01 | 显示全部楼层
超过255字符嗝屁:
  1. Sub test()
  2. Dim arr, i&, s$
  3. arr = [a1].CurrentRegion
  4. For i = 2 To UBound(arr)
  5.   s = s & Application.Rept(";""" & arr(i, 1) & """," & 1, arr(i, 2))
  6. Next i
  7. arr = Evaluate("{" & Mid(s, 2) & "}")
  8. [a2].Resize(UBound(arr), 2) = arr
  9. End Sub
复制代码
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2022-5-18 12:16 , Processed in 0.219261 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表