[已解决]请教一个解决方法，公式或VBA都行，只要能解决就好

14116518 · 发表于 2014-10-14 16:09

本帖最后由 14116518 于 2014-10-14 17:25 编辑

这个问题不知道怎么说，上传附件，请老师抽空给瞧瞧，先谢了

最佳答案

qh8600

2014-10-14 16:45

14116518 发表于 2014-10-14 16:41
难道是我没表达清楚意思

Sub demo()
Dim arr, x As Long, brr(1 To 1000, 1 To 1), crr(1 To 1000, 1 To 1), i As Long, j As Long
x = Sheets("表一").Cells(Rows.Count, 1).End(xlUp).Row
arr = Sheets("表一").Range("a2:c" & x)
For i = 1 To UBound(arr)
For j = 1 To arr(i, 3)
n = n + 1
brr(n, 1) = arr(i, 1)
crr(n, 1) = arr(i, 2)
Next
Next
Sheets("表二").Range("b3").Resize(n, 1) = brr
Sheets("表二").Range("h3").Resize(n, 1) = crr
End Sub

复制代码

请教.rar (16.04 KB, 下载次数: 3)

14116518 · 发表于 2014-10-14 16:41

难道是我没表达清楚意思

qh8600 · 发表于 2014-10-14 16:45

14116518 发表于 2014-10-14 16:41
难道是我没表达清楚意思

Sub demo()
Dim arr, x As Long, brr(1 To 1000, 1 To 1), crr(1 To 1000, 1 To 1), i As Long, j As Long
x = Sheets("表一").Cells(Rows.Count, 1).End(xlUp).Row
arr = Sheets("表一").Range("a2:c" & x)
For i = 1 To UBound(arr)
For j = 1 To arr(i, 3)
n = n + 1
brr(n, 1) = arr(i, 1)
crr(n, 1) = arr(i, 2)
Next
Next
Sheets("表二").Range("b3").Resize(n, 1) = brr
Sheets("表二").Range("h3").Resize(n, 1) = crr
End Sub

复制代码

请教.rar (16.04 KB, 下载次数: 3)

这儿有肥猫 · 发表于 2014-10-14 16:50

用技巧+公式就可以了哇

14116518 · 发表于 2014-10-14 16:57

qh8600 发表于 2014-10-14 16:45
楼主试试

老师，谢谢你，你的VBA完全达到我的要求，可我改到我实际表格中，改了下动应的数字，好像不对，我把数据调为我实际表格的位置了，麻烦老师再帮我改改，万分感谢。

zjdh · 发表于 2014-10-14 16:58

请教.rar (15.45 KB, 下载次数: 4)

14116518 · 发表于 2014-10-14 16:58

这儿有肥猫发表于 2014-10-14 16:50
用技巧+公式就可以了哇

老师，具体的操作方法呢？
VBA也学学
技巧跟公式也学学

14116518 · 发表于 2014-10-14 17:01

zjdh 发表于 2014-10-14 16:58

老师，这个写得好简洁，能不能帮我改下数据，谢谢了

qh8600 · 发表于 2014-10-14 17:03

14116518 发表于 2014-10-14 16:57
老师，谢谢你，你的VBA完全达到我的要求，可我改到我实际表格中，改了下动应的数字，好像不对，我把数据调 ...

请教.rar (16.62 KB, 下载次数: 3)

14116518 · 发表于 2014-10-14 17:25

qh8600 发表于 2014-10-14 17:03
这样

谢谢老师了

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