[已解决]生成的数据列数超过excel最大列

scl5801

hanjia 发表于 2016-7-12 16:42
是这样一直添加下去吗？？？？？
If x = 247  and x

注意数据要连续，要不会出现重复或者漏数

grf1973

那你行列转置吧，100多万行总够了吧。

hanjia

grf1973 发表于 2016-7-12 17:04
那你行列转置吧，100多万行总够了吧。

帮我行列转置一下  谢谢   
现在是 j1,k1,l1 生成的  帮我转成 j2,j3,j4 这样生成

grf1973

1. Sub Macro1()
   
2.     Dim arr, brr, i&, j%, k%
   
3.     arr = Range("a1:f" & [a65536].End(3).Row)
   
4.     ReDim brr(1 To UBound(arr), 1 To 1)
   
5.     arr1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
   
6.     ReDim w(0 To 494)
   
7.       For i = 0 To UBound(arr1) - 3
   
8.           For j = 1 To UBound(arr1) - 2
   
9.           If j > i Then
   
10.               For k = 2 To UBound(arr1) - 1
    
11.               If k > j Then
    
12.                   For l = 3 To UBound(arr1) - 0
    
13.                   If l > k Then
    
14.                        w(x) = Array(arr1(i), arr1(j), arr1(k), arr1(l))
    
15.                        x = x + 1
    
16.                   End If
    
17.                   Next
    
18.               End If
    
19.               Next
    
20.           End If
    
21.           Next
    
22.       Next
    
23.     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
24.     For x = 0 To UBound(w)
    
25.         For i = 2 To UBound(arr)
    
26.             s = 0
    
27.             For j = 1 To UBound(arr, 2)
    
28.                 For k = 0 To UBound(w(x))
    
29.                     If arr(i, j) = w(x)(k) Then s = s + 1
    
30.                 Next
    
31.                 If s >= 3 Then brr(i, 1) = 0: Exit For
    
32.             Next
    
33.             If s < 3 Then brr(i, 1) = brr(i - 1, 1) + 1
    
34.         Next
    
35.         Range("j2").Offset(x).Resize(1, UBound(brr)) = Application.Transpose(brr)
    
36.     Next
    
37. End Sub

复制代码