每周数据归档

hbszls

请老师们帮帮忙，要求见附件。

ykcbf1100

数据是全新复制还是追加式复制，这个事先要确定好的，二种方法处理手法大不相同，可以先出现一个选项，选择是追加还是覆盖。不要临时出现”是否覆盖“提示。

liulang0808

Sub 按钮3_Click()
    Sheets("周食谱").UsedRange.Offset(1).ClearContents
End Sub
Sub 按钮2_Click()
    r = Sheets("周食谱归档").Cells(Rows.Count, 1).End(3).Row
    brr = Sheets("周食谱").[a1].CurrentRegion
    arr = Sheets("周食谱归档").[a1].Resize(r + UBound(brr), 4)
    Set d = CreateObject("scripting.dictionary")
    For j = 2 To r
        str1 = CDate(arr(j, 1))
        For i = 2 To UBound(arr, 2)
            str1 = str1 & "##" & arr(j, i)
        Next i
        d(str1) = j
    Next j
    msg = ""
    For j = 2 To UBound(brr)
        str1 = CDate(brr(j, 1))
        For i = 2 To UBound(arr, 2)
            str1 = str1 & "##" & arr(j, i)
        Next i
        If d.exists(str1) Then
            If msg = "" Then
                msg = MsgBox("数据重复，是否覆盖？", vbYesNo, "提示")
            End If
            If msg = vbNo Then
                r = r + 1
                For i = 1 To UBound(arr, 2)
                    arr(r, i) = brr(j, i)
                Next i
            End If

        Else
            r = r + 1
            For i = 1 To UBound(arr, 2)
                arr(r, i) = brr(j, i)
            Next i
        End If
    Next j
    Sheets("周食谱归档").[a1].Resize(r, 4) = arr
End Sub

liulang0808

附件内容供参考。。。

hbszls

ykcbf1100 发表于 2024-8-21 09:38
数据是全新复制还是追加式复制，这个事先要确定好的，二种方法处理手法大不相同，可以先出现一个选项，选 ...

追加式复制,就是每次新填的数据，复制到归档的工作表中去保存，如果已经归档了，再次归档时，提示已经归档了，确认就是覆盖已经归楼的数据，但不是对以前已经归档的数据清除。

ykcbf1100

hbszls 发表于 2024-8-21 11:37
追加式复制,就是每次新填的数据，复制到归档的工作表中去保存，如果已经归档了，再次归档时，提示已经归 ...

版主帮你写了，我就不写了。