按A4纸张大小生成一张表格（已经解决）谢谢chxw68老师

努力学习01

chxw68 发表于 2020-2-25 20:41
详见附件。

非常感谢。。。。。完全符合要求。。谢谢

努力学习01

chxw68 发表于 2020-2-25 20:41
详见附件。

自动生成求助问题1.zip (114.03 KB, 下载次数: 2)

2020-2-25 20:57 上传

点击文件名下载附件

老师为什么只计算到155呢。。。后面应该还有很多都没计算到。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   With Worksheets("sheet1")
   
9.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
10.     arr = .Range("a4:b" & r).Value
    
11.     For i = 1 To UBound(arr)
    
12.       arr(i, 1) = Round(arr(i, 1), 2)
    
13.       n = Int(arr(i, 1) * 10)
    
14.       If n <> 0 And n = arr(i, 1) * 10 Then
    
15.         d(n) = arr(i, 2) * 1000
    
16.       End If
    
17.     Next
    
18.   End With
    
19.   arr = Application.Transpose(Array(d.keys, d.items))
    
20.   ReDim brr(1 To Application.Ceiling(UBound(arr) / (24 * 4), 1) * 24, 1 To 8)
    
21.   k = 1
    
22.   m = 1
    
23.   n = 1
    
24.   For i = 1 To UBound(arr)
    
25.     brr(k + m - 1, n) = arr(i, 1)
    
26.     brr(k + m - 1, n + 1) = arr(i, 2)
    
27.     m = m + 1
    
28.     If m > 24 Then
    
29.       n = n + 2
    
30.       m = 1
    
31.       If n > 7 Then
    
32.         k = k + 24
    
33.         m = 1
    
34.         n = 1
    
35.       End If
    
36.     End If
    
37.   Next
    
38.   With Worksheets("生成表")
    
39.     .Range("a4:h" & .Rows.Count).Clear
    
40.     .Range("a:a,c:c,e:e,g:g").NumberFormatLocal = "0.00"
    
41.     With .Range("a4").Resize(UBound(brr), UBound(brr, 2))
    
42.       .Value = brr
    
43.       .Borders.LineStyle = xlContinuous
    
44.     End With
    
45.     With .UsedRange
    
46.       .HorizontalAlignment = xlCenter
    
47.       .VerticalAlignment = xlCenter
    
48.     End With
    
49.   End With
    
50. End Sub
    

复制代码

chxw68

修改好了。

努力学习01

chxw68 发表于 2020-2-25 21:11
修改好了。

这下。。完全满足要求里。。。谢谢呀。。。

yjh_27

努力学习01 发表于 2020-2-25 20:00
对。。附件里两张表

生成表里的   字段1里  的1   其实   就   是前面  表字段1  里的0.1

第2步就是把   “把A4列的数乘以10列出来”的数    提取整数。（就是差不多把J列提取整数的意思）
L列的数是提取J列里是整数的数   

已经变了。

0不是整数？

1. Sub aa()
   
2. r = Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Row
   
3. arr = Sheets("Sheet1").Range("a4:b" & r)
   
4. r2 = 24
   
5. c2 = 4
   
6. 
   
7. ReDim scrr(1 To UBound(arr) / 4, 1 To c2 * 2)
   
8. sci = 1
   
9. scj = 1
   
10. For i = 1 To UBound(arr)
    
11.     If arr(i, 1) * 100 Mod 10 = 0 Then
    
12.         scrr(sci, scj) = arr(i, 1) * 10
    
13.         scrr(sci, scj + 1) = arr(i, 2) * 1000
    
14.         If sci Mod r2 = 0 Then
    
15.             If scj = c2 * 2 - 1 Then
    
16.                 sci = sci + 1
    
17.                 scj = 1
    
18.             Else
    
19.                 scj = scj + 2
    
20.                 sci = sci - r2 + 1
    
21.             End If
    
22.         Else
    
23.             sci = sci + 1
    
24.         End If
    
25.         If scimax < sci Then scimax = sci
    
26.     End If
    
27. Next
    
28. 
    
29. Sheets("生成表").Range("a4").Resize(scimax, c2 * 2) = scrr
    
30. 
    
31. End Sub
    

复制代码

努力学习01

yjh_27 发表于 2020-2-25 21:22
第2步就是把   “把A4列的数乘以10列出来”的数    提取整数。（就是差不多把J列提取整数的意思）
L列的 ...

恩。。0也算整数。。

被你这么一说，我也纠结了。。。

谢谢你们两位老师呀。。明天未问问领导看看。。0需不需要统计进来。。谢谢了。