VBA代码调用时没有正确执行

大家好，我希望你能帮上忙。 我有一段代码见下面。

我试图实现的是，用户打开一个Excel工作表，其中包含一个命令button和说明。 一旦命令button被点击，一个对话框打开，然后允许用户select另一个Excel工作表，一旦Excel工作表被选中，另一段代码（应该）触发和重复被合并，并且开始date和结束date被修改，并且工作表保持打开状态，无需重复，date正确。

这段代码

Public Sub ConsolidateDupes() 

当它在原始页面上运行时，它完美的工作，但是当我尝试用命令button调用它时，它不能正常工作。 没有错误出现，它只是不删除所有可能的重复，并不会将date工作到最早的开始和最后的结束date

我已经添加了图片，使解释更容易图1

带有命令button的Excel工作表

图片2要重新select原始状态的表单和重复的开始date和结束date

代码之后的所选工作表已由该工作表上的itslef运行

使用命令button调用选定的工作表

正如你希望看到的重复是留下来的date不工作到最早的开始date和最后的结束date

正如我所说的代码完美的工作原理自己在工作表上，但是当它被称为它留下重复，并没有工作的开始和结束date

这里是我的代码任何帮助是总是不胜感激。

码

 Sub Open_Workbook_Dialog() Dim my_FileName As Variant MsgBox "Select Denmark File" '<--| txt box for prompt to pick a file my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection If my_FileName <> False Then Workbooks.Open Filename:=my_FileName Call ConsolidateDupes '<--|Calls the Filter Code and executes End If End Sub Public Sub ConsolidateDupes() Dim wks As Worksheet Dim lastRow As Long Dim r As Long Set wks = Sheet1 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

你可以删除这个：

  Rows(r).Delete 

并写下这个：

  wks.Rows(r).Delete 

编辑：试试这个:(非常肮脏的解决scheme，但它应该工作）

 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 = wkb.Sheet1 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 

但是，问题在于它不起作用，因为您没有将my_FileName传递给ConsolidateDupes过程。 因此，程序正在用button在文件中执行，这在那里是没有意义的。

嗨所以一些变化需要得到这个工作和代码的作品是低于我希望它可以帮助一个同胞VBA'r出:-)

  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 ' Sort the B Column Alphabetically With ActiveWorkbook.Sheets(1) Dim LastRow2 As Long LastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row Dim LastCol As Long LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column With ActiveWorkbook.Worksheets("Sheet1").Sort .SortFields.Clear .SortFields.Add Key:=Range(Cells(2, 2), Cells(LastRow, 2)), _ SortOn:=xlSortOnValues, _ Order:=xlAscending, _ DataOption:=xlSortNormal .SetRange Range(Cells(2, 1), Cells(LastRow, LastCol)) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With 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 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 ' Delete Duplicate Rows(r).Delete End If Next End Sub