Question

我有一个监视文件夹并将结果放在excel文件中的脚本。是否有一种方法，当一个细胞在30分钟后变为绿色的细胞得到了？如果30分钟后细胞没有变化，它会变成红色吗？

我忘了提到我想检查多个细胞。

这是picture。 f下的一切

我希望这很清楚，因为我的英语不好。需要检查laatste导入（最后导入）

我的代码：

'===== 
Const adVarChar = 200 
Const adDate = 7 
Const adBigInt = 20
'============================================================================== 
'Set objecten 
Set WshShell = WScript.CreateObject("WScript.Shell")
set fso = createobject("scripting.filesystemobject") 
set objPadImport = fso.getfolder("\\netko-sbs\data\imports\") 
Set SubfolderImport = objPadImport.SubFolders
ExcelBestand = "\\netko-sbs\data\imports\output.xlsx"
Set objFile = FSO.OpenTextFile("C:\Users\Karim\Desktop\Vbscripttest\importV3\lokaties.txt",  ForReading)


'Waarden
Const ForReading = 1
Dim arrFileLines()
i = 0
Do Until objFile.AtEndOfStream
  Redim Preserve arrFileLines(i)
  arrFileLines(i) = objFile.ReadLine
  i = i + 1
Loop
objFile.Close
'============================================================================== 
'WScript.Sleep 10000 'Sleeps for 10 seconds
'============================================================================== 
'create a custom disconnected recordset 
'with fields for filename and last modified date. 
'==============================================================================
'Record set maken 
'============================================================================== 
set rs = createobject("ador.recordset") 
rs.fields.append "foldername",adVarChar,255 
rs.fields.append "moddate",adDate   
rs.fields.append "naam",advarchar,255
rs.fields.append "tijd", advarchar,20
'==============================================================================
'Excel
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = FALSE 'Foutmeldingen uitschakelen
Set objWorkbook = objExcel.Workbooks.Add() 'Bestand openen..
'objWorkbook.SaveAs(ExcelBestand)
objExcel.Visible = True  'toon excel
objExcel.Cells(1, 1).Value = "foldernaam" 'Header instellen
objExcel.Cells(1, 2).Value = "Laatste import" 'Header instellen
objExcel.Cells(1, 3).Value = "Controle tijd" 'Header instellen

x = 2 'set de juiste rij in excel. 
'============================================================================== 
rs.open 
'===== 
'load it with file name, date, etc. (mapen controleren)
'==============================================================================
'==============================================================================             
For Each strLine in arrFileLines
     s = split( strline, "," ) 
     set folder = fso.getfolder( s(0) ) 
     'set test = (folder.datelastmodified - s(2))

     rs.addnew array("foldername","moddate", "naam", "tijd"), _ 
           array(folder.name,folder.datelastmodified, s(1), s(2)) ',test) 
     rs.update 

Next

s = "Sortering van Oud naar Nieuw:" & vbcrlf  _ 
  & "=============================" & vbcrlf 
if not (rs.bof and rs.eof) then 
  rs.sort = "moddate asc" 
  rs.movefirst 
  do until rs.eof 
    objExcel.Cells(x, 1).Value = _
        rs.Fields("naam").Value 
    objExcel.Cells(x, 2).Value = _
        rs.Fields("moddate").Value 
    objExcel.Cells(x, 3).Value = _
        rs.Fields("tijd").Value 
        x = x + 1
    rs.movenext 
  loop 
end if 


'Excel
Set objRange = objExcel.Range("A1") 'Selecteer actieve cell
objRange.Activate 'Activeer cell

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit() 'Set grootte van kolom

Set objRange = objExcel.Range("B1") 'Selecteer actieve cell
objRange.Activate 'Activeer cell

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit() 'Set grootte van kolom

Set objRange = objExcel.Range("C1") 'Selecteer actieve cell
objRange.Activate 'Activeer cell

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit() 'Set grootte van kolom
'==============================================================================
VarType moddate = objExcel.Cells(1, 1).Value = "Laatste import"
if DateDiff("n",moddate,Date) < 30 then 
objExcel.Cells(y,y).Interior.ColorIndex = 3 
Else objExcel.Cells(1,1).Interior.ColorIndex = 4 

end if
'==============================================================================
ObjWorkbook.SaveAs(ExcelBestand) 'Excel bestand opslaan
'objExcel.Quit 'Excel afsluiten als nodig is.
'==============================================================================
'==============================================================================

'objFile.WriteLine s 'Schrijf waarden naar Excel
Set rs = nothing 'Gooi RS leeg 
Set folder = nothing 'Object leegmaken
set fso = nothing 'Object leegmaken
set objPadImport = nothing
set objPadFrigo = nothing
set SubfolderFrigo = nothing 
set objExcel = nothing
'==============================================================================

Answer 1

getlastmodified时间将单元格存储在单元格或变量中。

例如：如果你把时间存储在一个单元格中，那么

var lastmodifitime = objExcel.Cells（x，1）.Value

＆＃39;如果在最后30分钟内修改了单元格值，则将其设置为红色，否则如果在最后30分钟内未修改，则设置背景颜色为绿色

如果DateDiff（＆＃34; n＆＃34;，lastmodifitime，Date）＆lt; 30然后 objExcel.Cells（y，y）.Interior.ColorIndex = 3 其他 objExcel.Cells（z，z）.Interior.ColorIndex = 4 结束如果

＆＃39;此链接将帮助您获取上次修改时间：http://www.online-tech-tips.com/ms-office-tips/track-changes-in-excel/

Answer 2

您可以使用Application.OnTime()函数在一定时间间隔后调用Excel子例程。如果您只是尝试监视单个单元格，则可以使用单个标志来指定单元格的值是否已更改。 Worksheet_Change()事件可用于更新标志。

例如，在Module中，添加以下代码：

' Create global flag to indicate if cell value has changed.
Public CellChanged As Boolean

' Call this routine to start the monitor.
Public Sub StartMonitor()
    CellChanged = False    ' Init
    Application.OnTime Now() + TimeValue("00:30:00"), "CheckIfChange"
End Sub

' This will be called by the monitor after 30 mins.
Public Sub CheckIfChange()
    If CellChanged Then Sheet1.Cells(2, 2).Interior.Color = vbGreen
End Sub

然后，在工作表中，只需添加一些代码，以便在目标单元格的值发生更改时更新全局标记。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 2 Then If Target.Column = 2 Then CellChanged = True
End Sub

我需要用计时器更改excel中的单元格颜色

2 个答案: