VBA输入去重复

meiswin

要求：

1、根据日期和班次条件进行去重，只保留最新输入的那一个数据；

2、以最后一次输入的数值为最新数值，删除之前重复项保留最后一次输入数值

microyip

字典去重就解决了

轩辕传说

字典去重就解决了

MOY838840554

不用字典啊，为什么要用字典，数据是一行一行输入的，不是一下就输入一堆数据。
Private Sub CommandButton1_Click()
    Dim X%, Y%, new_arr, old_arr, i, j
    With Sheet1
        'Rows.Count表格总行数
        X = .Cells(Rows.Count, "B").End(xlUp).Row + 1 'xlUP向上查找range非空单元格.行号
        j = 1
        If ComboBox1.Text = "" Or TextBox1.Text = "" Then
            MsgBox "请输入数据", , "提示" '弹出消息窗口
            Exit Sub '退出程序
        Else
             old_arr = .Range("B2:E" & X) '源数据写入数组old_arr
            ReDim new_arr(1 To UBound(old_arr) + 1, 1 To 4) '重新定义数组大小new_arr(行，列)
            For i = 1 To UBound(old_arr)
                '源数据除开新输入班次外的数据写入数组new_arr
                If old_arr(i, 3) <> "" And old_arr(i, 3) <> ComboBox1.Text Then
                    new_arr(j, 1) = j '第1列序号
                    new_arr(j, 2) = old_arr(i, 2) '第2列日期
                    new_arr(j, 3) = old_arr(i, 3) '第3列班次
                    new_arr(j, 4) = old_arr(i, 4) '第4列产量
                    j = j + 1 '变量j+1
                End If
            Next i
            '新输入班次的数据写入数组new_arr最后1行
            new_arr(j, 1) = j '第1列序号
            new_arr(j, 2) = Format(Now, "yyyy-m-d") '第2列日期
            new_arr(j, 3) = ComboBox1.Text '第3列班次
            new_arr(j, 4) = TextBox1.Text '第4列产量
            '处理好的数组new_arr写回表格
            .Range("B2:E" & X) = "" '清空源数据
            .Range("B2:E" & j + 1) = new_arr '写回
        End If
    End With
End Sub

meiswin

MOY838840554 发表于 2019-1-12 09:13
不用字典啊，为什么要用字典，数据是一行一行输入的，不是一下就输入一堆数据。
Private Sub CommandButto ...

已经达到我要求的意思，我想问一个问题，就是如果这个表格是整年度的，在新建组内的数据会不会非常大，导致重新写回表格的时候卡死或者季度缓慢。

meiswin

轩辕传说 发表于 2019-1-12 08:53
字典去重就解决了

我的意思就是，每天只能有ABC班的数据存在，其他只要多输入的都是保留最新的产量。

meiswin

microyip 发表于 2019-1-12 08:06
字典去重就解决了

字典去重我不会用，在定义字典之后，如何对比字典内容，并且删除或者覆盖，到了这步我就歇菜了；
然后我照着人家的，依葫芦画瓢，又没有任何作用：
Dim Dic As Object, Dic2 As Object, End_Row_No As Integer, Arr, Brr, rng
Set Dic = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
  With ActiveSheet
    End_Row_No = .[B100000].End(xlUp).Row
    Arr = .Range("C2:C" & End_Row_No)
    Brr = .Range("D2:D" & End_Row_No)
End With
     Set rng = Nothing
For i = UBound(Arr) To 1 Step -1
        For j = UBound(Brr) To 1
        If Dic.exists(Arr(i, 1)) = Format(Now, "yyyy-m-d") Then
         If Dic2.exists(Brr(j, 1)) = ComboBox1.Text Then
             If rng Is Nothing Then
                 Set rng = Cells(i, 1)
             Else
                 Set rng = Union(rng, Cells(i, 1))
             End If
        Else
             Dic(Arr(i, 1)) = 1
         End If
        End If
        Next
        Next
    If Not rng Is Nothing Then rng.EntireRow.Delete