[已解决]如何根据excel单元格内的一个值自动生成到另一个sheet内的行

灯盏

大灰狼1976 发表于 2017-4-19 16:52
没看明白你要把哪一行的数据同步到哪一行去，除了栋楼名称和单元数量外，都是空的。

这个是有数据的，同步到下面就行，1栋同步1栋的，2栋同步2栋的

灯盏

大灰狼1976 发表于 2017-4-19 16:52
没看明白你要把哪一行的数据同步到哪一行去，除了栋楼名称和单元数量外，都是空的。

大神你在么？

大灰狼1976

放到模板1工作表试试

1. Private Sub CommandButton1_Click()
   
2. Dim n&, s$, i&, j&, k&, arr, brr, r&
   
3. arr = [b2:r7]
   
4. ReDim brr(1 To Application.Sum(Application.Index(arr, , 2)), 1 To UBound(arr, 2))
   
5. For i = 1 To UBound(arr)
   
6.   If arr(i, 1) = "" Then Exit For
   
7.     n = arr(i, 2)
   
8.     s = arr(i, 1)
   
9.     For j = 1 To n
   
10.       r = r + 1
    
11.       brr(r, 1) = s
    
12.       brr(r, 2) = j
    
13.       For k = 3 To UBound(arr, 2)
    
14.         brr(r, k) = arr(i, k)
    
15.       Next k
    
16.     Next j
    
17. Next i
    
18. [b9].Resize(r, UBound(brr, 2)) = brr
    
19. End Sub

复制代码

灯盏

大灰狼1976 发表于 2017-4-20 09:43
放到模板1工作表试试

原数组的取值范围 arr   这个修改之后还是一样的效果，是哪里出了问题么？改为b2：o7  效果与r7还是一样的

灯盏

大灰狼1976 发表于 2017-4-20 09:43
放到模板1工作表试试

感觉像是，只要上面又信息，下面就会同步

大灰狼1976

灯盏 发表于 2017-4-20 10:14
原数组的取值范围 arr   这个修改之后还是一样的效果，是哪里出了问题么？改为b2：o7  效果与r7还是一样 ...

o7和r7结果一样的原因是o7后面的单元格区域都没有数据，当然是一样的，如果有数据就能看出区别了。
还是这句话，先要理解。

灯盏

大灰狼1976 发表于 2017-4-20 10:39
o7和r7结果一样的原因是o7后面的单元格区域都没有数据，当然是一样的，如果有数据就能看出区别了。
还是 ...

明白了，还有一个附件，大神帮看下，这种的怎么生成

大灰狼1976

1. Private Sub CommandButton1_Click()
   
2. Dim n&, s$, i&, j&, k&, arr, brr, crr, r&
   
3. arr = [b17:ad20]
   
4. For i = 1 To UBound(arr)
   
5.   If arr(i, 3) = "" Then Exit For
   
6.   brr = Split(arr(i, 3), "-")
   
7.   n = n + (brr(1) - brr(0)) / 100 + 1
   
8. Next i
   
9. ReDim brr(1 To n, 1 To UBound(arr, 2))
   
10. For i = 1 To UBound(arr)
    
11.   If arr(i, 1) = "" Then Exit For
    
12.   crr = Split(arr(i, 3), "-")
    
13.   For j = crr(0) To crr(1) Step 100
    
14.     r = r + 1
    
15.     For k = 1 To UBound(arr, 2)
    
16.       brr(r, k) = arr(i, k)
    
17.     Next k
    
18.     brr(r, 3) = j
    
19.     brr(r, 4) = Int(j / 100)
    
20.   Next j
    
21. Next i
    
22. [c27].Resize(r, UBound(brr, 2)) = brr
    
23. End Sub

复制代码

灯盏

大灰狼1976 发表于 2017-4-20 11:17

两个不能同时生效么？

灯盏

大灰狼1976 发表于 2017-4-20 11:17

大神看看我这个问题出在哪里