[已解决]如何用循环把数据转化成列。请高手相助。多谢了。

跑跑2014

详细情况在工作薄中说明，请教高手，看有什么好办法得到　2表我想要的结果，得出数据。多谢了。

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-3-27 10:12

1. Sub oneColumn()
   
2.     Dim i&, j&, k&
   
3.     Dim result, arr
   
4.     With Sheet7
   
5.         i = .Cells(Rows.Count, 1).End(xlUp).Row
   
6.         arr = .Range("a1:k" & i).Value
   
7.     End With
   
8.     ReDim result(0 To UBound(arr) * 5, 1 To 2)
   
9.     result(0, 1) = "名称": result(0, 2) = "数量"
   
10.     For j = 7 To UBound(arr, 2)
    
11.         For i = 2 To UBound(arr)
    
12.             k = k + 1
    
13.             result(k, 1) = arr(1, j) & arr(i, 1)
    
14.             result(k, 2) = Val(arr(i, j))
    
15.         Next
    
16.     Next
    
17.     Sheet1.UsedRange.ClearContents
    
18.     Sheet1.Range("a1").Resize(k + 1, 2).Value = result
    
19.     MsgBox "ok"
    
20. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

这个很容易呀，循环，嫌麻烦就定义个大的静态数组，或者动态数组。

冥王

占座

hwc2ycy

1. Sub oneColumn()
   
2.     Dim i&, j&, k&
   
3.     Dim result, arr
   
4.     With Sheet7
   
5.         i = .Cells(Rows.Count, 1).End(xlUp).Row
   
6.         arr = .Range("a1:k" & i).Value
   
7.     End With
   
8.     ReDim result(0 To UBound(arr) * 5, 1 To 2)
   
9.     result(0, 1) = "名称": result(0, 2) = "数量"
   
10.     For j = 7 To UBound(arr, 2)
    
11.         For i = 2 To UBound(arr)
    
12.             k = k + 1
    
13.             result(k, 1) = arr(1, j) & arr(i, 1)
    
14.             result(k, 2) = Val(arr(i, j))
    
15.         Next
    
16.     Next
    
17.     Sheet1.UsedRange.ClearContents
    
18.     Sheet1.Range("a1").Resize(k + 1, 2).Value = result
    
19.     MsgBox "ok"
    
20. End Sub

复制代码

跑跑2014

hwc2ycy 发表于 2014-3-27 10:12

非常感谢，是我要的效果，现在还有一点就是增加工具没问题，提取数据后，2表都能体现出来，但是　增加工地的时候，提取数据　2表不能体现，我想把工地最大可增加的列数为　bc列，　　改您的代码再执行就失败了。
Sub oneColumn()
    Dim i&, j&, k&
    Dim result, arr
    With Sheet7
        i = .Cells(Rows.Count, 1).End(xlUp).Row
        arr = .Range("a1:bc" & i).Value
    End With
    ReDim result(0 To UBound(arr) * 5, 1 To 2)
    result(0, 1) = "名称": result(0, 2) = "数量"
    For j = 7 To UBound(arr, 2)
        For i = 2 To UBound(arr)
            k = k + 1
            result(bc, 1) = arr(1, j) & arr(i, 1)
            result(bc, 2) = Val(arr(i, j))
        Next
    Next
    Sheet1.UsedRange.ClearContents
    Sheet1.Range("a1").Resize(bc + 1, 2).Value = result
    MsgBox "ok"
End Sub
您帮忙再修改下这个地方代码，谢谢

hwc2ycy

ReDim result(0 To UBound(arr) * 5, 1 To 2)
这里原来只针对5列做的。
你可以改下。