Question

我有一个红狮数据站，记录大约25个烤箱的温度，数据以CSV文件存储在网络上。我想每两分钟将这些数据导入Excel文件，但只在初始导入后导入更改。导入后，VBA必须释放CSV文件2分钟，以便数据站可以更新。我在网上搜索过，这个网站和我找到的最接近的东西是以下代码。此代码查找更改但不导入文件。任何帮助，将不胜感激。

Dim NextTime As Date
 Function LastModTime(FileSpec As String) As Date
 'Returns the date-time the file specified by FileSpec (path string) was last modified
 Dim fs, f, s
 Set fs = CreateObject("Scripting.FileSystemObject")
 Set f = fs.GetFile(FileSpec)
 LastModTime = f.DateLastModified
 End Function
 Sub Check4Changes()
 'Checks the file FilePath for changes every 60 seconds
 'If file has changed, pops up a message box. Stores the
 'last modified time in cell M1 of Sheet1
 ChDir "Q:\Manufacturing\Equipment\DispatchLogs\logs\7-DES"
 Const FilePath As String = "Q:\Manufacturing\Equipment\DispatchLogs\logs\7-DES\*.csv"
 Dim LastMod As Date

 On Error GoTo ReSchedule

 LastMod = LastModTime(FilePath)

 With Worksheets("Sheet1").Range("C1")
 If IsEmpty(.Value) Then
 .Value = LastMod
 GoTo ReSchedule
 ElseIf .Value < LastMod Then
 .Value = LastMod
 MsgBox FilePath & " updated.", vbInformation, "Check4Changes"
 End If
 End With

 ReSchedule:
 'Reschedule this same routine to run in one minute.
 NextTime = Now + 2 / 1440
 Application.StatusBar = "Next check at " & NextTime
 Application.OnTime NextTime, "Check4Changes"

 End Sub
 Sub CancelChecking()
 Application.OnTime NextTime, "Check4Changes", Schedule:=False
 Application.StatusBar = False
 End Sub

Answer 1

我写了一些能给你基本想法的代码

Sub Main（）

Dim Wbk_CSV As Excel.Workbook
Dim Excel_Wbk As Excel.Workbook
Dim Var_WholeCSVData As Variant
Dim Var_ExcelData As Variant
Dim Var_ToUpdate As Variant
Dim NumOfRows As Long
Dim Last_Row As Long
Set Wbk_CSV = Workbooks.Open("PathWithFileName")
Wbk_CSV.Sheets(1).Activate

Last_Row = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'Taking whole data in a variant
'Change the range as per the data in csv file
Var_WholeCSVData = Wbk_CSV.Sheets(1).Range("A2:D" & Last_Row).Value 'Considering first row as header row and there are 4 columns
'After taking whole data in varinat close csv file without saving
Wbk_CSV.Close savechanges:=False
Set Wbk_CSV = Nothing

'Now open excel file in which data will be updated
Set Excel_Wbk = Workbooks.Open("PathWithFileName")
Excel_Wbk.Sheets(1).Activate

Last_Row = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Var_ExcelData = Excel_Wbk.Sheets(1).Range("A2:D" & Last_Row).Value 'Considering first row as header row

NumOfRows = 0
'This function will return count of updated rows and data to update
Var_ToUpdate = Delete_Duplicates(Var_WholeCSVData, Var_ExcelData, NumOfRows)
Excel_Wbk.Sheets(1).Activate
'paste data
If NumOfRows > 0 Then
    ActiveSheet.Range("A" & Last_Row + 1 & ":D" & Last_Row + NumOfRows).Value = Var_ToUpdate
End If

Excel_Wbk.Close savechanges:=True
Set Excel_Wbk = Nothing
'result
MsgBox ("Number of rows imported: " & NumOfRows)

End Sub

函数Delete_Duplicates（Var_FromCSV As Variant，Var_FromExcel As Variant，ByRef NumberOfRowToupdate As Long）As Variant

'using dictinpary objects
Dim dict_Duplicates As Object
Dim i_AddToDict, i, j As Long
Dim Str_value As String
Dim Var_Temp As Variant
Dim lng_temp As Long
Set dict_Duplicates = CreateObject("Scripting.Dictionary")

ReDim Var_Temp(1 To UBound(Var_FromCSV, 1), 1 To UBound(Var_FromCSV, 2))

'Add excel data to dict. by concatenating
'All unique values will be added
For i_AddToDict = 1 To UBound(Var_FromCSV)
    Str_value = CStr(Var_FromExcel(i_AddToDict, 1) & Var_FromExcel(i_AddToDict, 2) & Var_FromExcel(i_AddToDict, 3) & Var_FromExcel(i_AddToDict, 4))
    If dict_Duplicates.exists(Str_value) Then
        'do nothing
    Else
        dict_Duplicates.Add Str_value, 1
    End If
Next i_AddToDict

'looking for values which are not available in excel file
For i = 1 To UBound(Var_FromCSV)
    Str_value = CStr(Var_FromCSV(i_AddToDict, 1) & Var_FromCSV(i_AddToDict, 2) & Var_FromCSV(i_AddToDict, 3) & Var_FromCSV(i_AddToDict, 4))
    If dict_Duplicates.exists(Str_value) Then
        'do nothing
    Else
        'storing values in a variant
        For j = 1 To 4
            Var_Temp(lng_temp, j) = Var_FromCSV(i, j)
        Next j
        lng_temp = lng_temp + 1
        dict_Duplicates.Add Str_value, 1
    End If
Next i

NumberOfRowToupdate = lng_temp - 1
Delete_Duplicates = Var_Temp

结束功能

如何使用VBA将CSV导入Excel

1 个答案: