求助程序撰写

bjzhangkai

老师们好，附件格式是需要将原格式数据，转换为需要转换格式，其中原格式数据行数为动态行数，会随着输入量的增加而增加。

CheryBTL

1. Sub 数据转换()
   
2.     Dim ar, re
   
3.     Dim i As Integer, j As Integer, Cnt As Integer, b As Boolean
   
4.     ar = Sheets(1).Range("A1").CurrentRegion
   
5.     ReDim re(1 To 999, 1 To 3)
   
6.     For i = 2 To UBound(ar)
   
7.         b = False
   
8.         For j = 2 To UBound(ar, 2)
   
9.             If ar(i, j) <> "" Then
   
10.                 b = True
    
11.                 Cnt = Cnt + 1
    
12.                 re(Cnt, 1) = ar(i, 1)
    
13.                 re(Cnt, 2) = ar(i, j)
    
14.                 re(Cnt, 3) = ar(1, j)
    
15.             End If
    
16.         Next j
    
17.         If b Then Cnt = Cnt + 1
    
18.     Next i
    
19.     Sheets(2).Range("A1:C65536").ClearContents
    
20.     Sheets(2).[a1].Resize(UBound(re), 3) = re
    
21. End Sub
    

复制代码

CheryBTL

你这样还要自己花金币，不如直接评最佳好了 {:3112:}

bjzhangkai

CheryBTL 发表于 2013-12-13 14:27
你这样还要自己花金币，不如直接评最佳好了

哈 没事，要感谢你，你真的很强大，能加q吗