[已解决]工资条循环出错

wengrobert

请问如何生成多行的工资条，循环好像有问题，请指教。

最佳答案

月排行榜 / 总排行榜

today0427

2016-7-1 11:28

好了

跳转到最佳答案楼层

today0427

看看是否符合你的要求

1. Sub today()
   
2.     Dim arr, brr(), i&, j%, n&
   
3.         arr = Sheets("数据源").Range("j1:aa" & Sheets("数据源").[j65536].End(3).Row)
   
4.         ReDim brr(1 To UBound(arr) * 7, 1 To 6)
   
5.             For i = 2 To UBound(arr)
   
6.                 For j = 1 To UBound(arr, 2)
   
7.                     brr(i * 7 - 13 + Int((j - 0.1) / 6) * 2, (j - 1) Mod 6 + 1) = arr(1, j)
   
8.                     brr(i * 7 - 12 + Int((j - 0.1) / 6) * 2, (j - 1) Mod 6 + 1) = arr(i, j)
   
9.                 Next
   
10.             Next
    
11.             
    
12.         With Sheets("佣金报告")
    
13.             .Cells.Clear
    
14.             n = (i - 2) * 7
    
15.             .[a1].Resize(n, 6) = brr
    
16.             Sheets("2014佣金").Columns("A:F").Copy
    
17.             .Columns("A:F").PasteSpecial Paste:=xlPasteFormats
    
18.             Sheets("2014佣金").Rows("1:7").Copy
    
19.             .Rows("1:" & n).PasteSpecial Paste:=xlPasteFormats
    
20.             Application.CutCopyMode = False
    
21.         End With
    
22. End Sub

复制代码

为什么代码粘上去这么丑？强迫症看的好难受！

wengrobert

today0427 发表于 2016-6-30 22:32
看看是否符合你的要求为什么代码粘上去这么丑？强迫症看的好难受！

老师你好！我没有将项目写全，现在补充了相关的项目，我试着修改代码，但是报错了，请老师辛苦修改，谢谢！

today0427

为什么给你答题还要花钱买你的附件？我感觉我不能理解这个世界了！让我好好想想，想想……

today0427

好了

today0427

如果你想修改生成文件的格式，行高列宽等，你可以直接修改“2014佣金”那个表，因为后面那个生成表是以那个2014佣金表为模板把格式刷上去的，希望你满意！

wengrobert

today0427 发表于 2016-7-1 10:19
为什么给你答题还要花钱买你的附件？我感觉我不能理解这个世界了！让我好好想想，想想……

啊，我搞错了，应该是奖金

wengrobert

today0427 发表于 2016-7-1 10:19
为什么给你答题还要花钱买你的附件？我感觉我不能理解这个世界了！让我好好想想，想想……

请问如何悬赏发帖？谢谢

today0427

我挣一个最佳，人家挣10块，我才挣了5块，哭死！

today0427

这个亲家翁表现不错，准备好好考察下！