censuspopdata,数据挑选

今天看了一篇Python编写电子表格的视频，以自己薄弱的编程知识，想着用VBA实现相同的功能，结果，悲剧了。DoEvents还是今天刚查得的，虽时间更长，但是不出现“未响应”的字样了，为什么不刷屏，是为了节省时间。对于数据少的情况还好，对于7W多行的数据，呵呵了。censuspopdata是数据源。

 

Sub try()

Application.ScreenUpdating = False

Dim ii, ij As Long

For ik = 0 To 2
    Cells(1, "F").Offset(0, ik) = Cells(1, "B").Offset(0, ik)
Next
ii = 2
Do While Cells(ii, "A") <> ""
    ij = 2
    Do While Cells(ij, "F") <> ""
        If Cells(ii, "B") = Cells(ij, "F") And Cells(ii, "C") = Cells(ij, "G") Then
            Cells(ij, "H") = Cells(ij, "H") + Cells(ii, "D")
            Exit Do
        End If
        ij = ij + 1
    Loop
    If Cells(ij, "F") = "" Then
        For ik = 0 To 2
            Cells(ij, "F").Offset(0, ik) = Cells(ii, "B").Offset(0, ik)
        Next
    End If
    ii = ii + 1
    DoEvents
Loop

Application.ScreenUpdating = True

End Sub

晚上回家想了想，问题在于数据太长，对比太多。先排个序，对于电子表格老说简单些的，然后在对比数据，要不新建一行，要不直接加。变的好一些了。可能还是比不上字典啊什么的，关键是自己能编写出来。

Sub try()

Application.ScreenUpdating = False

Dim ii, ij As Long

ii = 1
ij = 1
For ik = 0 To 2
    Cells(ij, "F").Offset(0, ik) = Cells(ii, "B").Offset(0, ik)
Next
ii = ii + 1
Do While Cells(ii, "A") <> ""
    If Cells(ii, "B") = Cells(ij, "F") And Cells(ii, "C") = Cells(ij, "G") Then
        Cells(ij, "H") = Cells(ij, "H") + Cells(ii, "D")
    Else
        ij = ij + 1
        For ik = 0 To 2
            Cells(ij, "F").Offset(0, ik) = Cells(ii, "B").Offset(0, ik)
        Next
    End If
    ii = ii + 1
    DoEvents
Loop

Application.ScreenUpdating = True

End Sub