|
本帖最后由 510437958 于 2016-7-8 20:29 编辑
再次非常感谢准提部林老师和三无(沉迷)帅哥的帮助,可是两位老师很难联系上,所以希望他们有机会看到或别的老师看到了愿意尝试修改一下代码,谢谢!
先附上准提老师的代码(排名不分先后)
Private Sub CommandButton1_Click()
UsedRange.Offset(2).ClearContents
rw = Sheets("数据源").[ap65536].End(3).Row
ReDim ar(1 To rw, 1 To 38)
Set d = CreateObject("Scripting.Dictionary")
m = -2
For i = 4 To rw
If Sheets("数据源").Cells(i, 42) <> "" Then
Set x = Range("f2:al2").Find(Sheets("数据源").Cells(i, 3), , , 1)
If x Is Nothing Then
GoTo 500
Else
l = x.Column
End If
s1 = Format(Sheets("数据源").Cells(i, 34), "yyyy年m月")
s2 = Sheets("数据源").Cells(i, 66) & "(" & Sheets("数据源").Cells(i, 42) & ")"
s = s1 & s2
If Not d.Exists(s) Then
m = m + 3
d(s) = m
ar(m, 1) = s1
ar(m, 2) = "征收"
ar(m, 3) = s2
ar(m + 1, 1) = s1
ar(m + 1, 2) = "入库"
ar(m + 1, 3) = s2
ar(m + 2, 1) = s1
ar(m + 2, 2) = "在途"
ar(m + 2, 3) = s2
If Sheets("数据源").Cells(i, 54) <> "" Then
If l > 24 Then
ar(m, 4) = Sheets("数据源").Cells(i, 9)
ar(m + 1, 4) = Sheets("数据源").Cells(i, 9)
ar(m, 24) = Sheets("数据源").Cells(i, 9)
ar(m + 1, 24) = Sheets("数据源").Cells(i, 9)
ar(m, l) = Sheets("数据源").Cells(i, 9)
ar(m + 1, l) = Sheets("数据源").Cells(i, 9)
Else
ar(m, 4) = Sheets("数据源").Cells(i, 9)
ar(m + 1, 4) = Sheets("数据源").Cells(i, 9)
ar(m, 5) = Sheets("数据源").Cells(i, 9)
ar(m + 1, 5) = Sheets("数据源").Cells(i, 9)
ar(m, l) = Sheets("数据源").Cells(i, 9)
ar(m + 1, l) = Sheets("数据源").Cells(i, 9)
End If
Else
If l > 24 Then
ar(m, 4) = Sheets("数据源").Cells(i, 9)
ar(m + 2, 4) = Sheets("数据源").Cells(i, 9)
ar(m, 24) = Sheets("数据源").Cells(i, 9)
ar(m + 2, 24) = Sheets("数据源").Cells(i, 9)
ar(m, l) = Sheets("数据源").Cells(i, 9)
ar(m + 2, l) = Sheets("数据源").Cells(i, 9)
Else
ar(m, 4) = Sheets("数据源").Cells(i, 9)
ar(m + 2, 4) = Sheets("数据源").Cells(i, 9)
ar(m, 5) = Sheets("数据源").Cells(i, 9)
ar(m + 2, 5) = Sheets("数据源").Cells(i, 9)
ar(m, l) = Sheets("数据源").Cells(i, 9)
ar(m + 2, l) = Sheets("数据源").Cells(i, 9)
End If
End If
Else
If Sheets("数据源").Cells(i, 54) <> "" Then
If l > 24 Then
ar(d(s), 4) = ar(d(s), 4) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 1, 4) = ar(d(s) + 1, 4) + Sheets("数据源").Cells(i, 9)
ar(d(s), 24) = ar(d(s), 24) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 1, 24) = ar(d(s) + 1, 24) + Sheets("数据源").Cells(i, 9)
ar(d(s), l) = ar(d(s), l) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 1, l) = ar(d(s) + 1, l) + Sheets("数据源").Cells(i, 9)
Else
ar(d(s), 4) = ar(d(s), 4) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 1, 4) = ar(d(s) + 1, 4) + Sheets("数据源").Cells(i, 9)
ar(d(s), 5) = ar(d(s), 5) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 1, 5) = ar(d(s) + 1, 5) + Sheets("数据源").Cells(i, 9)
ar(d(s), l) = ar(d(s), l) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 1, l) = ar(d(s) + 1, l) + Sheets("数据源").Cells(i, 9)
End If
Else
If l > 24 Then
ar(d(s), 4) = ar(d(s), 4) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 2, 4) = ar(d(s) + 2, 4) + Sheets("数据源").Cells(i, 9)
ar(d(s), 24) = ar(d(s), 24) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 2, 24) = ar(d(s) + 2, 24) + Sheets("数据源").Cells(i, 9)
ar(d(s), l) = ar(d(s), l) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 2, l) = ar(d(s) + 2, l) + Sheets("数据源").Cells(i, 9)
Else
ar(d(s), 4) = ar(d(s), 4) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 2, 4) = ar(d(s) + 2, 4) + Sheets("数据源").Cells(i, 9)
ar(d(s), 5) = ar(d(s), 5) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 2, 5) = ar(d(s) + 2, 5) + Sheets("数据源").Cells(i, 9)
ar(d(s), l) = ar(d(s), l) + Sheets("数据源").Cells(i, 9)
ar(d(s) + 2, l) = ar(d(s) + 2, l) + Sheets("数据源").Cells(i, 9)
End If
End If
End If
End If
500:
Next
If m > 0 Then
[a3].Resize(m + 2, 38) = ar
MsgBox "已统计结果!"
End If
End Sub
代码对BN列街道乡镇进行了重复排错,只限定第一个乡镇和公司数据,所以导致总数对不上,比如腾飞镇有可能对应二公司、也有可能对应3公司等。
顺便解释一下:AH列不为空表示征收数,BB列部位空表示入库数,差额为在途数,BN列+(AP列数据)组合计算当月征收、入库、在途数,分不同产品
|
|