利用VBA从条码扫描枪中提取数据

Question

Private Sub 复制扫描记录() '复制扫描记录
Application.ScreenUpdating = False
Dim smjl As String, i As Integer, arr() As String, x As Integer, c As Integer, a As Integer
'smjl = ThisWorkbook.Path & "\扫描记录.xlsx" '需要修改成扫描枪的 fullname
'C:\Users\ruku\AppData\Local\Temp\WPDNSE\f%7CS%7C%5C\data.xls
smjl = "C:\Users\ruku\AppData\Local\Temp\WPDNSE\f%7CS%7C%5C\data.xls" '这个是扫描枪路径
Application.Workbooks.Open smjl
x = ActiveWorkbook.ActiveSheet.Range("a65536").End(xlUp).Row
ReDim arr(1 To x)
For i = 1 To x
arr(i) = Trim(ActiveWorkbook.ActiveSheet.Range("a" & i).Value)
Next i
' ActiveWorkbook.Close True

ThisWorkbook.Activate

With ActiveWorkbook.Sheets(1)
.Range("a3：c1000").Clear
For c = 1 To x
.Range("b" & c + 2) = arr(c)
.Range("a" & c + 2) = "=row()-2"
.Range("c" & c + 2) = Application.CountIf(Range("b2:b" & c + 1), Range("b" & c + 1))

If .Range("c" & c + 2) > 1 Then
.Range("a" & c + 2&, "c" & c + 2).Interior.ColorIndex = 3
Else
.Range("a" & c + 2&, "c" & c + 2).Interior.ColorIndex = 0
End If
Next c
End With

' a = ActiveWorkbook.ActiveSheet.Range("b65536").End(xlUp).Row
' ActiveWorkbook.ActiveSheet.Range("a2:a" & a) = "=row()-1"
' ActiveWorkbook.ActiveSheet.Range("c2:c" & a) = Application.WorksheetFunction.CountIf(Range("b2:b" & a), Range("b2"))
MsgBox "共导入记录" & x & "条！"
smjl = ""
Erase arr
Application.ScreenUpdating = True
End Sub

上面这个过程，，，我很惊奇的发现，当我把源数据表修改（h或者重新扫描）过后，重新从源表提取数据，发现提取到的竟然是未修过之前的数据，

但是当我手动将源表打开、关闭后，再运行过程，结果却是正确的，，，，，，

求大神指点下，怎么破？

Answer 1

Application.Calculate 重新计算加进去试一下，我没有扫描枪，不能测试，只能判断是没刷新。追问

加在过程最后吗？

追答

你试试，我觉得是加在读取数据完成之后。

追问

加上去，没有效果，Application.Calculate不是重新计算公式吗？ 对变量应该没效果吧