Question

我希望你能提供帮助。我有一段代码，它的效果相对较好。

它的作用是使用命令按钮打开一个对话框，允许用户在选择此工作表后选择另一个Excel工作表，然后合并重复项并创建一个具有最早可能开始日期和最新状态的新行。可能的结束日期然后删除重复的行。

所以在Pic 1中

我们可以看到，我们有多个具有多个开始日期和结束日期的行，代码应该做的是查找具有最早开始日期和最晚结束日期的重复项并创建一个新行。

图1。

在图2中您可以看到重复项已被删除，第一次重复日期是正确的，最早的开始日期和最晚的结束日期可能AgnholtJørgenSteen开始日期01/04/2016结束日期2016年6月17日

但对于Breum Leif来说，这是错误的方式围绕04/05/2016 2016年1月13日

图2。

我的代码可以修改以解决此问题。一如往常，任何帮助都非常感谢。

我的代码如下。

代码

Sub Open_Workbook_Dialog()


    Dim strFileName     As String
    Dim wkb             As Workbook
    Dim wks             As Worksheet
    Dim lastRow         As Long
    Dim r               As Long

    MsgBox "Select Denmark File" '<--| txt box for prompt to pick a file

        strFileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection

    Set wkb = Application.Workbooks.Open(strFileName)
    Set wks = ActiveWorkbook.Sheets(1)
    lastRow = wks.UsedRange.Rows.Count

    For r = lastRow To 3 Step -1
        ' Identify Duplicate
        If wks.Cells(r, 1) = wks.Cells(r - 1, 1) _
        And wks.Cells(r, 2) = wks.Cells(r - 1, 2) _
        And wks.Cells(r, 3) = wks.Cells(r - 1, 3) _
        And wks.Cells(r, 4) = wks.Cells(r - 1, 4) _
        And wks.Cells(r, 5) = wks.Cells(r - 1, 5) _
        And wks.Cells(r, 6) = wks.Cells(r - 1, 6) _
        And wks.Cells(r, 7) = wks.Cells(r - 1, 7) Then
            ' Update Start Date on Previous Row
            If wks.Cells(r, 8) < wks.Cells(r - 1, 8) Then
                wks.Cells(r - 1, 8) = wks.Cells(r, 8)
            End If
            ' Update End Date on Previous Row
            If wks.Cells(r, 9) > wks.Cells(r - 1, 9) Then
                wks.Cells(r - 1, 9) = wks.Cells(r, 9)
            End If
            ' Delete Duplicate
            Rows(r).Delete
        End If
    Next
End Sub

Answer 1

根据您的输出判断，H和I列中的单元格似乎是文本，而不是日期。因此"04/05/2016"小于"13/01/2016"，（对于Anders Nyboe Andersen）"15/03/2016"大于"14/03/2016"大于"07/04/2016"。

提供您的区域设置是这样的，日期表示为“dd / mm / yyyy”格式（您的个人资料显示爱尔兰，所以我猜他们是），您可以通过转换单元格中的文本来使您的测试正常工作在进行比较之前成为Date：

' Update Start Date on Previous Row
If CDate(wks.Cells(r, 8)) < CDate(wks.Cells(r - 1, 8)) Then
    wks.Cells(r - 1, 8) = wks.Cells(r, 8)
End If
' Update End Date on Previous Row
If CDate(wks.Cells(r, 9)) > CDate(wks.Cells(r - 1, 9)) Then
    wks.Cells(r - 1, 9) = wks.Cells(r, 9)
End If

VBA代码不会更正所有数据行的日期

1 个答案: