[已解决]VBA代码运行的问题！运行此代码后，为什么老是执行最后一条语句了？

luhua8468

Dim sht1 As Worksheet

Dim sht2 As Worksheet

Sub 综合计划与消耗出入统计()

Set sht1 = Worksheets("综合计划")

Set sht2 = Worksheets("综合消耗")


   a = sht1.Range("A1").CurrentRegion.Rows.Count

   b = sht2.Range("A1").CurrentRegion.Rows.Count

   For m = 4 To a

   For n = 3 To b

   If sht1.Cells(m, 2) = sht2.Cells(n, 2) And sht1.Cells(m, 3) = sht2.Cells(n, 3) And sht1.Cells(m, 5) = sht2.Cells(n, 5) Then

        sht2.Cells(n, 10) = "按计划领用"

       ElseIf sht1.Cells(m, 2) = sht2.Cells(n, 2) And sht1.Cells(m, 3) = sht2.Cells(n, 3) And sht1.Cells(m, 5) > sht2.Cells(n, 5) Then

        sht2.Cells(n, 10) = "按计划领用后剩余" & sht1.Cells(m, 5) - sht2.Cells(n, 5) & sht2.Cells(n, 4)

       ElseIf sht1.Cells(m, 2) = sht2.Cells(n, 2) And sht1.Cells(m, 3) = sht2.Cells(n, 3) And sht1.Cells(m, 5) < sht2.Cells(n, 5) Then

        sht2.Cells(n, 10) = "超预算领用" & sht2.Cells(n, 5) - sht1.Cells(m, 5) & sht2.Cells(n, 4)

       ElseIf sht1.Cells(m, 2) = sht2.Cells(n, 2) And sht1.Cells(m, 3) <> sht2.Cells(n, 3) Then

        sht2.Cells(n, 10) = "本月未计划而超预算消耗"

       ElseIf sht2.Cells(n, 2) <> sht1.Cells(m, 2) And sht1.Cells(m, 2) <> "" And sht2.Cells(n, 2) <> "" Then

        sht1.Cells(m, 8) = "本月未领用"

        sht2.Cells(n, 10) = "未计划而超预算消耗"

     End If

     Next n

     Next m

     End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2016-3-3 11:20

用字典做了一个比较的，重新梳理了一下思路。

1. Sub 综合计划与消耗出入统计()
   
2.     Set sht1 = Worksheets("综合计划")
   
3.     Set sht2 = Worksheets("综合消耗")
   
4.     sht1.[h4:h1000] = ""
   
5.     sht2.[J3:J1000] = ""
   
6.     arr = sht1.[a1].CurrentRegion
   
7.     brr = sht2.[a1].CurrentRegion
   
8.     Set d = CreateObject("scripting.dictionary")     '计划表有的品种
   
9.     Set d1 = CreateObject("scripting.dictionary")        '领用表有的品种
   
10.     For i = 4 To UBound(arr)   '各品种的计划量
    
11.         x = arr(i, 2) & arr(i, 3)
    
12.         If Len(x) > 0 Then d(x) = arr(i, 5)
    
13.     Next
    
14.    
    
15.     For i = 3 To UBound(brr)
    
16.         x = brr(i, 2) & brr(i, 3)
    
17.         y = brr(i, 5)    '领用量
    
18.         If Len(x) > 0 Then
    
19.             d1(x) = ""     '领用表有
    
20.             If d.exists(x) Then       '计划表有，领用表有
    
21.                 s = d(x) - y
    
22.                 brr(i, 10) = IIf(s = 0, "按计划领用", IIf(s > 0, "按计划领用后剩余" & s, "超预算领用" & (-s)))
    
23.             Else        '计划表无，领用表有
    
24.                 brr(i, 10) = "本月未计划而超预算消耗"
    
25.             End If
    
26.         End If
    
27.     Next
    
28.     sht2.[J1].Resize(UBound(brr)) = Application.Index(brr, , 10)
    
29.    
    
30.    For i = 4 To UBound(arr)   '
    
31.         x = arr(i, 2) & arr(i, 3)
    
32.         If Len(x) > 0 And Not d1.exists(x) Then arr(i, 8) = "本月未领用"        '计划表有，领用表无
    
33.     Next
    
34.     sht1.[H1].Resize(UBound(arr)) = Application.Index(arr, , 8)
    
35. End Sub

复制代码

跳转到最佳答案楼层

grf1973

你的代码肯定有问题啦。对相同的n，不同的m，表一的cells(m,2)一直在变，所以导致表二的cells(n,10)也一直在变，一直到最后一个m为止才不变。

grf1973

用字典做了一个比较的，重新梳理了一下思路。

1. Sub 综合计划与消耗出入统计()
   
2.     Set sht1 = Worksheets("综合计划")
   
3.     Set sht2 = Worksheets("综合消耗")
   
4.     sht1.[h4:h1000] = ""
   
5.     sht2.[J3:J1000] = ""
   
6.     arr = sht1.[a1].CurrentRegion
   
7.     brr = sht2.[a1].CurrentRegion
   
8.     Set d = CreateObject("scripting.dictionary")     '计划表有的品种
   
9.     Set d1 = CreateObject("scripting.dictionary")        '领用表有的品种
   
10.     For i = 4 To UBound(arr)   '各品种的计划量
    
11.         x = arr(i, 2) & arr(i, 3)
    
12.         If Len(x) > 0 Then d(x) = arr(i, 5)
    
13.     Next
    
14.    
    
15.     For i = 3 To UBound(brr)
    
16.         x = brr(i, 2) & brr(i, 3)
    
17.         y = brr(i, 5)    '领用量
    
18.         If Len(x) > 0 Then
    
19.             d1(x) = ""     '领用表有
    
20.             If d.exists(x) Then       '计划表有，领用表有
    
21.                 s = d(x) - y
    
22.                 brr(i, 10) = IIf(s = 0, "按计划领用", IIf(s > 0, "按计划领用后剩余" & s, "超预算领用" & (-s)))
    
23.             Else        '计划表无，领用表有
    
24.                 brr(i, 10) = "本月未计划而超预算消耗"
    
25.             End If
    
26.         End If
    
27.     Next
    
28.     sht2.[J1].Resize(UBound(brr)) = Application.Index(brr, , 10)
    
29.    
    
30.    For i = 4 To UBound(arr)   '
    
31.         x = arr(i, 2) & arr(i, 3)
    
32.         If Len(x) > 0 And Not d1.exists(x) Then arr(i, 8) = "本月未领用"        '计划表有，领用表无
    
33.     Next
    
34.     sht1.[H1].Resize(UBound(arr)) = Application.Index(arr, , 8)
    
35. End Sub

复制代码

luhua8468

grf1973 发表于 2016-3-3 11:20
用字典做了一个比较的，重新梳理了一下思路。

非常感谢！