数据导入时将原有数据删除后导入

Mark.W

附件功能基本实现，也不知道代码写的是否合理，反正效果是达到了，但是还有个问题，同一日期、同一班组数据，假如第一次录入数据错误，第二次重新记录保存时，如何先将对应班组数据表内第一次导入日期数据删除呢？删除后再保存最新数据，请大神帮忙看看如何修改。
Sub 保存()
Dim i As Long, bz As String, rng As Range
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
    d(sh.Name) = ""
Next sh
i = 3
bz = Worksheets("sheet1").Cells(i, "F").Value
Do While bz <> ""
If Not d.exists(bz) Then
        p = MsgBox("无该班组信息")
        Exit Sub
        Else
        End If
Dim a As Byte
For a = 3 To 30 Step 1
   Select Case Range("F" & a).Value
          Case Is <> ""
               Sheet1.Range("i" & a).Value = Format$(Now, "HH:MM:SS-YY/M/D")
          Case Else
               Sheet1.Range("i" & a).Value = ""
End Select
Next a
Set rng = Worksheets(bz).Range("A65536").End(xlUp).Offset(1, 0)
Worksheets("sheet1").Cells(i, "A").Resize(1, 9).Copy rng
i = i + 1
bz = Worksheets("sheet1").Cells(i, "F").Value
Loop
End Sub

Mark.W

VBA初学者，各位大神帮帮忙看一下，这个代码如何修改

Mark.W

小弟已经发了好几个帖子求助，跪求各位大神帮助，万分感谢！

liulang0808

1. Sub ±￡′&#230;()
   
2.     Dim i As Long, bz As String, rng As Range
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For Each sh In Sheets
   
5.         d(sh.Name) = ""
   
6.     Next sh
   
7.     Dim a As Byte
   
8.     For a = 3 To Sheet1.Cells(Rows.Count, "f").End(3).Row Step 1
   
9.        Select Case Range("F" & a).Value
   
10.               Case Is <> ""
    
11.                    Sheet1.Range("i" & a).Value = Format$(Now, "HH:MM:SS-YY/M/D")
    
12.               Case Else
    
13.                    Sheet1.Range("i" & a).Value = ""
    
14.         End Select
    
15.     Next a
    
16.     i = 3
    
17.     bz = Worksheets("sheet1").Cells(i, "F").Value
    
18.     Do While bz <> ""
    
19.         If Not d.exists(bz) Then
    
20.             p = MsgBox("&#206;T&#184;&#195;°à×éD&#197;&#207;￠")
    
21.             Exit Sub
    
22.             Else
    
23.         End If
    
24.    
    
25.         Set rng = Worksheets(bz).Range("A65536").End(xlUp).Offset(1, 0)
    
26.         Worksheets("sheet1").Cells(i, "A").Resize(1, 9).Copy rng
    
27.         i = i + 1
    
28.         bz = Worksheets("sheet1").Cells(i, "F").Value
    
29.     Loop
    
30. End Sub

复制代码

以上代码做了调整，供楼主参考
假如第一次录入数据错误，第二次怎么能确定哪一条是错误的？如果知道哪条错误，根据关键字匹配然后覆盖掉即可

Mark.W

非常感谢！可能是我描述的不清楚，是根据日期来判定，假如3-12日数据已经保存，再次点击保存时，直接将第一次导入所有3-12日所有行数据删除，然后再保存最新3-12日数据，最终结果是，同一天日期同一个人只有一条记录，请帮忙修改一下，这个地方感觉很简单，但是一直写不出来。
另外，假如保存数据已到3-12日，再次重新录入3-11日数据时，保存至对应班组工作表时，只需要继续在空白单元行记录即可，记录顺序无所谓。

Mark.W

liulang0808 发表于 2019-3-23 07:55
以上代码做了调整，供楼主参考
假如第一次录入数据错误，第二次怎么能确定哪一条是错误的？如果知道哪条 ...

说简单点，就是不需要判定录入数据是否错误，只需要判定同一天日期不重复，因此只需要再次录入同一天数据时，首先将班组工作表内记录原有日期所有数据删除即可。

liulang0808

Mark.W 发表于 2019-3-23 19:46
说简单点，就是不需要判定录入数据是否错误，只需要判定同一天日期不重复，因此只需要再次录入同一天数据 ...

录入完，再去遍历各张表，根据关键字检索，从下遍历表格，看看当天是否有两条记录，有的话，删除上面那一条

Mark.W

liulang0808 发表于 2019-3-23 19:59
录入完，再去遍历各张表，根据关键字检索，从下遍历表格，看看当天是否有两条记录，有的话，删除上面那一 ...

这个方式可以，但是我想将代码加入保存代码之后，是想保存后直接进入保存工作表内执行这个代码，这样可以吗？ 帮忙指教，谢谢！
Dim cf
    cf = [c65536].End(xlUp).Row
    cf = cf - 1
    While cf >= 2
        If Cells(cf, "b") = Cells(cf + 1, "b") Then
            Rows(cf).Delete
        Else
            cf = cf - 1
        End If
    Wend

Mark.W

liulang0808 发表于 2019-3-23 19:59
录入完，再去遍历各张表，根据关键字检索，从下遍历表格，看看当天是否有两条记录，有的话，删除上面那一 ...

你好，貌似用这样的方式有问题，因为我的条件是日期列，当天日期会有多个人存在，如果用这中方式，只会保留日期列的最后一个人，所以不行，最好是在数据保存导入指定表格时，首先进行判定，如果导入表内是否有要导入日期数据，是则找到这些行数据将其删除，然后再将数据保存，否则直接保存，请帮忙看一下，万分感谢

liulang0808

Mark.W 发表于 2019-3-24 09:43
你好，貌似用这样的方式有问题，因为我的条件是日期列，当天日期会有多个人存在，如果用这中方式，只会保 ...

首先判断时间是否是当天，然后再根据第二个关键字判断是否有重复。。。。