简体   繁体   中英

Excel 2010 crashes when using VBA

I am trying to code a bit of VBA to compare a date from one column to the dates in another column. My code is:

Sub ForLoop()

    Dim i As Integer
    Dim j As Integer
    Dim homenum As Integer
    Dim dif As Long
    Dim clockin As Long
    Dim clockout As Long

    For i = 2 To 18418

        clockin = Cells(i, 4).Value
        homenum = Cells(i, 5).Value
        dif = 100

        For j = 2 To 18418
            clockout = Cells(j, 6).Value
            If Cells(j, 5).Value = homenum & Abs((clockin - clockout) * 24 * 60) < Abs(dif) Then
                dif = Abs((clockin - clockout) * 24 * 60)
            End If
        Next j

        Cells(i, 9).Value = Abs(dif)
    Next i
End Sub

Whenever I try to run this, Excel crashes, and I end up having to end the program from Task Manager. I can't find any reason for that in my code. Does anyone have any ideas?

A quick example of the input I'm working with:

在此处输入图像描述

This should be a lot faster - switched from cell-by-cell reads/writes to using arrays without changing your basic logic.

Sub ForLoop()

    Dim i As Long, j As Long, homenum As Long 'prefer Long over Integer
    Dim dif As Long, clockin As Long, clockout As Long
    Dim ws As Worksheet, data, lr As Long, ub As Long, arrDiffs, d
    
    Set ws = ActiveSheet 'always specify a worksheet, even if Activesheet...

    lr = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row 'last-occupied row in E
    
    data = ws.Range("D2:F" & lr).Value 'read all data as array
    ub = UBound(data, 1)               'get "rows" upper bound
    
    arrDiffs = ws.Range("I2:I" & lr).Value 'read dif column to array
    
    For i = 1 To ub

        clockin = data(i, 1) '1 = D
        homenum = data(i, 2) '2 = E
        dif = 100

        For j = 1 To ub
            If data(j, 2) = homenum Then
                clockout = data(j, 3)  '3 = F 
                d = Abs((clockin - clockout) * 24 * 60)
                If d < dif Then dif = d
            End If
        Next j
        arrDiffs(i, 1) = dif 'update diff array
    Next i
    ws.Range("I2:I" & lr).Value = arrDiffs 'write all diffs back to sheet
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM