[已解决]求助生成一个明细表

走进EXCEL

各位老师，求助生成一个日明细表。谢谢！！ 销售明细.rar (12.91 KB, 下载次数: 7)

2017-1-14 08:20 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

today0427

2017-1-16 02:04

结果显示在新建的结果表中，我对比了一下，只有最后一行那个午餐肉咱俩结果不一样，但是我看我计算的没错，就不知道你是什么标准了。

1. Sub today()
   
2.     Dim r&, ks%, rr%, js%, cp, pl, arr(1 To 100000, 1 To 13), i&
   
3.     cp = Sheets("2ËÆ·ÏúêÛ±í").UsedRange
   
4.     pl = Sheets("Åäáϱí").UsedRange
   
5.     For r = 2 To UBound(cp)
   
6.         For ks = 4 To UBound(pl)
   
7.             If pl(ks, 1) = cp(r, 5) Then
   
8.                 For rr = ks + 1 To UBound(pl)
   
9.                     If pl(rr, 1) = "" And pl(rr, 10) = "" Or pl(rr, 1) <> "" Then js = rr - 1: Exit For
   
10.                 Next
    
11.                 Exit For
    
12.             End If
    
13.         Next
    
14.         For cc = 3 To 10 Step 7
    
15.             For rr = ks To js
    
16.                 If pl(rr, cc) <> "" Then
    
17.                     i = i + 1
    
18.                     arr(i, 1) = cp(r, 1): arr(i, 2) = cp(r, 2): arr(i, 3) = cp(r, 3)
    
19.                     arr(i, 5) = pl(rr, cc): arr(i, 6) = pl(rr, cc + 1): arr(i, 7) = pl(rr, cc + 2)
    
20.                     arr(i, 11) = cp(r, 11) * pl(rr, cc + 3): arr(i, 12) = pl(rr, cc + 4): arr(i, 13) = arr(i, 11) * arr(i, 12)
    
21.                 Else: Exit For
    
22.                 End If
    
23.             Next
    
24.         Next
    
25.     Next
    
26.     With Sheets("&#189;á1&#251;±í")
    
27.         .Cells.Clear
    
28.         Sheets("êy&#190;Y&#191;a").Rows("1:1").Copy .[a1]
    
29.         .[a2].Resize(i, 13) = arr
    
30.         .Activate
    
31.     End With
    
32. End Sub
    

复制代码

跳转到最佳答案楼层

hupin6331

是这样吗？

today0427

结果显示在新建的结果表中，我对比了一下，只有最后一行那个午餐肉咱俩结果不一样，但是我看我计算的没错，就不知道你是什么标准了。

1. Sub today()
   
2.     Dim r&, ks%, rr%, js%, cp, pl, arr(1 To 100000, 1 To 13), i&
   
3.     cp = Sheets("2&#203;&#198;·&#207;úê&#219;±í").UsedRange
   
4.     pl = Sheets("&#197;&#228;á&#207;±í").UsedRange
   
5.     For r = 2 To UBound(cp)
   
6.         For ks = 4 To UBound(pl)
   
7.             If pl(ks, 1) = cp(r, 5) Then
   
8.                 For rr = ks + 1 To UBound(pl)
   
9.                     If pl(rr, 1) = "" And pl(rr, 10) = "" Or pl(rr, 1) <> "" Then js = rr - 1: Exit For
   
10.                 Next
    
11.                 Exit For
    
12.             End If
    
13.         Next
    
14.         For cc = 3 To 10 Step 7
    
15.             For rr = ks To js
    
16.                 If pl(rr, cc) <> "" Then
    
17.                     i = i + 1
    
18.                     arr(i, 1) = cp(r, 1): arr(i, 2) = cp(r, 2): arr(i, 3) = cp(r, 3)
    
19.                     arr(i, 5) = pl(rr, cc): arr(i, 6) = pl(rr, cc + 1): arr(i, 7) = pl(rr, cc + 2)
    
20.                     arr(i, 11) = cp(r, 11) * pl(rr, cc + 3): arr(i, 12) = pl(rr, cc + 4): arr(i, 13) = arr(i, 11) * arr(i, 12)
    
21.                 Else: Exit For
    
22.                 End If
    
23.             Next
    
24.         Next
    
25.     Next
    
26.     With Sheets("&#189;á1&#251;±í")
    
27.         .Cells.Clear
    
28.         Sheets("êy&#190;Y&#191;a").Rows("1:1").Copy .[a1]
    
29.         .[a2].Resize(i, 13) = arr
    
30.         .Activate
    
31.     End With
    
32. End Sub
    

复制代码

laoau138

today0427 发表于 2017-1-16 02:04
结果显示在新建的结果表中，我对比了一下，只有最后一行那个午餐肉咱俩结果不一样，但是我看我计算的没错， ...

这个VBA代码错在哪里不能通过


http://www.excelpx.com/thread-427224-1-1.html