比较不同工作簿上的列并从一个工作簿复制到另一个工作簿

时间:2014-06-03 15:35:18

标签: excel vba excel-vba

编辑:我是否需要使用对象模型?

所以我在使用这个程序时遇到了麻烦。我编写了一个GUI,它有两个列表框和一些按钮。我正在尝试启动程序,选择一列数据/数字与另一个工作表上的另一列数据/数字进行比较,然后将第一个数据/数字的相邻单元格复制到程序中指定的单元格。我的代码的副本部分工作得很好但是当我添加所有的工作表内容时,它就退出了工作状态。我不知道是不是因为你在做完之后不能在两张纸上进行比较。活动/。打开或者如果我明白不明白。活动和。打开。如果我做错了什么,我不知道如何解决它。任何建议将不胜感激。

由于

尼克

P.S我只包含了我认为存在问题的代码部分。如果需要,我可以提交整件事。

Sub copy2()

 Dim ColCopyTo As String 'the column you want to copy to
  Dim ColSelect As String 'the column with the initial data
  Dim ColCompare 'the column you want to compare the initial data with
  Dim ColCopyFrom 'the column you want to copy data from
  Dim RowCrntCompare As Long
  Dim RowCrntSelect As Long
  Dim RowLastColCompare As Long
  Dim RowLastColSelect As Long
  Dim SelectValue As String
  Dim WorkSheetSelect As Worksheet 'the worksheet with initial data
  Dim WorkSheetCompare As Worksheet ' the worksheet you want to compare initial data on
  Dim WorkBookCompare As Workbook 'the workbook you want to compare initial data on
  Dim WorkBookSelect As Workbook ' the workbook with initial data on it
  Dim WorkSheetIndex As Integer

  With Sheet1

    continue = False 'initialise continue to false
    MsgBox "Select the Workbook and Worksheet"
    CommandButton2.Visible = True
    CommandButton1.Visible = False

    Call Wait 'pause until button is clicked

    'MsgBox ListBox2.value

    WorkSheetIndex = udfSheetIndex(ListBox2.value) 'index of the worksheet
    'MsgBox WorkSheetIndex

   'Set WorkBookSelect = Workbooks(ListBox1.value)
    Set WorkBookSelect = Workbooks.Open(ListBox1.value)
    WorkBookSelect.Activate
    Set WorkSheetSelect = ActiveWorkbook.Sheets(WorkSheetIndex)

    'Set WorkBookCompare = ActiveWorkbook.Sheets(WorkSheetSelect)
    'WorkBookSelect.Activate ' set the initial workbook to active

    WorkSheetSelect.Activate ' set the initial worksheet to active
    ColSelect = InputBox("which column do you want to select From") 'column you want to first select for copying
    ColCopyFrom = InputBox("which column do you want to copy data ColCopyFrom") 'where you are copying data from

    continue = False 'reset continue to false
    MsgBox "select the workbook and worksheet you want to compare to"
    CommandButton2.Visible = True
    Call Wait 'wait for button click
    'Set WorkBookCompare = Workbooks(ListBox1.value)
    Set WorkBookCompare = Workbooks.Open(ListBox1.value)
    WorkBookCompare.Activate
    MsgBox ListBox2.value
    WorkSheetIndex = udfSheetIndex(ListBox2.value) 'index of the worksheet
    MsgBox "listbox2" & ListBox2.value
    MsgBox WorkSheetIndex
    Set WorkSheetCompare = ActiveWorkbook.Sheets(WorkSheetIndex)
    WorkBookCompare.Activate 'set the second workbook to active
    WorkSheetCompare.Activate ' set the second worksheet to active

    ColCompare = InputBox("which column do you want to compare to ") 'the column you are comparing it to
    ColCopyTo = InputBox("which column do you want to copy data to") 'where you are copying data to

    RowLastColSelect = .Range(ColSelect & .Rows.Count).End(xlUp).Row 'length of the selected column
    RowLastColCompare = .Range(ColCompare & .Rows.Count).End(xlUp).Row 'length of ColCompare

    For RowCrntSelect = 1 To RowLastColSelect Step 1 ' from 1 to last
      SelectValue = .Cells(RowCrntSelect, ColSelect).value ' value of cell
        'MsgBox SelectValue
      If SelectValue <> "" Then
        For RowCrntCompare = 1 To RowLastColCompare Step 1
          If SelectValue = Cells(RowCrntCompare, ColCompare).value Then
            .Cells(RowCrntCompare, ColCopyTo).value = _
                                           .Cells(RowCrntSelect, ColCopyFrom).value
          End If
        Next RowCrntCompare
      End If
    Next RowCrntSelect

  End With

End Sub

1 个答案:

答案 0 :(得分:0)

在你的行上:

WorkSheetIndex = udfSheetIndex(ListBox2.value) 'index of the worksheet

尝试使用:

WorkSheetIndex = Sheets(ListBox2.value).Index

UDF代表“用户定义函数”,所以我猜它不起作用,因为函数设置不正确。