如何在Excel中插入一个使用VBA的3个条件的新表时删除表中的旧条目？

所以这对我来说有点棘手，因为我从3天前开始学习

我有一个4列的表格：站名| date| 节目名称| 状态

当我插入一个新的logging时，它将匹配较旧的logging，但是date总是不同的。

我需要一个代码添加到我的代码，将允许通过自动search类似的logging：站名称+程序名称 – 但只为当前月份，并删除旧的现有logging，然后写入新的。

---

这是我现在的代码连接到一个button：

Sub OK() Application.ScreenUpdating = False ' Check if all data was filled With Empt If IsEmpty(Sheet1.Range("D4").Value) = True Then MsgBox "Please fill all fields" ' ElseIf IsEmpty(Sheet1.Range("E4").Value) = True Then 'MsgBox "Please fill all fields" ElseIf IsEmpty(Sheet1.Range("F4").Value) = True Then MsgBox "Please fill all fields" ElseIf IsEmpty(Sheet1.Range("G4").Value) = True Then MsgBox "Please fill all fields" Else 'Insert data to table Sheet1.Range("E4").Value = Now() Sheet1.Range("D4:G4").Copy Sheet1.Range("A10").Rows("1:1").Insert Shift:=xlDown MsgBox "All data have been copied!" Sheet1.Range("D4:G4").ClearContents 'Sheet1.Range("E4").Value = "Auto Fill" End If End With 'CHANGE COLOR OF CELLS With colrng NonEmp = Sheet1.Application.CountA(Range("D10:D100000")) Set MyPlage = Range("D10:D10" & NonEmp) For Each Cell In MyPlage Select Case Cell.Value Case Is = "Completed" Cell.Interior.ColorIndex = 43 Case Is = "Waiting" Cell.Interior.ColorIndex = 3 Case Is = "Uploading" Cell.Interior.ColorIndex = 6 Case Else Cell.EntireRow.Interior.ColorIndex = xlNone End Select Next End With ' Save records Sheet1.Range("A10:E50000").Validation.Delete ThisWorkbook.Save End Sub 

---

有人可以帮忙吗？

Answer 1

 Option Explicit Public Sub OK() Dim ws As Worksheet, ur As Range, lr As Long, inc As Range, ref As Range Set ws = Worksheets("Main") Set inc = ws.Range("D4:G4") 'Insert Data Set ref = ws.Range("A9") 'Station With ws lr = .Cells(.Rows.Count, 4).End(xlUp).Row If inputIsValid(.Range("D4,F4,G4")) Then Application.ScreenUpdating = False Set ur = .Range(ref, "D" & lr) removePrev ur, .Range("D4"), .Range("F4") .Range("E4").Value = Now inc.Copy ref.Rows(2).Insert Shift:=xlDown inc.ClearContents With ref.Offset(1, 3) Select Case .Value2 Case "Completed": .Interior.ColorIndex = 43 Case "Waiting": .Interior.ColorIndex = 3 Case "Uploading": .Interior.ColorIndex = 6 End Select End With .Range("D4").Activate ThisWorkbook.Save Application.ScreenUpdating = True End If End With End Sub Private Function inputIsValid(ByRef inRng As Range) As Boolean Dim cel As Range, result As Boolean, invRng As Range result = True For Each cel In inRng If Len(cel) = 0 Then If invRng Is Nothing Then Set invRng = cel Else Set invRng = Union(invRng, cel) result = False End If Next If Not result Then invRng.Interior.Color = vbBlue MsgBox "Please enter values in blue cell(s)" invRng.Interior.ColorIndex = xlColorIndexAutomatic ThisWorkbook.Saved = True End If inputIsValid = result End Function Private Sub removePrev(ByRef rng As Range, ByVal sn As String, pn As String) Dim v As Range With rng Set v = rng.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) On Error Resume Next .AutoFilter Field:=1, Criteria1:=sn If v.SpecialCells(xlCellTypeVisible).Count > 1 Then .AutoFilter Field:=2, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic If v.SpecialCells(xlCellTypeVisible).Count > 1 Then .AutoFilter Field:=3, Criteria1:=pn If .SpecialCells(xlCellTypeVisible).Count > 1 Then v.SpecialCells(xlCellTypeVisible).Rows.EntireRow.Delete End If End If End If .AutoFilter End With End Sub 

---

• 它适用于以下testing文件：

  

。

注意：最后一个子（showStatus）可以被replace为3条件格式规则：