在vba中访问单独的excel文件时,.Select不起作用。为什么?

时间:2017-01-05 20:13:06

标签: excel vba excel-vba

我正在创建一个代码,用于打开另一个文件,执行一些操作并关闭它。在我打开的文件中,有一个函数可以在关闭时组织数据。

我不知道如何在VBA中对过滤器进行编码,因此我录制了一个宏并将其粘贴到我的函数中。代码在我自己运行时工作,但是当我调用main函数时,'.Select'似乎没有选择单元格/列,导致失败。

第一个函数来自第一个工作簿,第二个函数在第一个函数关闭文件时被调用。

'*********First Function************
Sub AddDrawing_Button() 'activated by button in worksheet

PN = Sheets("New Drawing").Range("C5").Cells(1, 1).Value        'Part Number,    D
Rev = Sheets("New Drawing").Range("C5").Cells(3, 1).Value       'Revision,       E

Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\Desktop\MasterDataFile.xlsm") 'Finds the file
Workbooks("MasterDataFile").Worksheets("DATA").Activate
t = Sheets("DATA").Range("D65536").End(xlUp).Row + 1 'finds the bottom row + 1

Sheets("DATA").Range("D1").Cells(t, 1).Value = PN               'Part Number,    D
Sheets("DATA").Range("D1").Cells(t, 8).Value = Rev              'Revision,       E

Workbooks("MasterDataFile").Close SaveChanges:=True
'upon closing this file, it jumps to the following code
Application.ScreenUpdating = True

End Sub

'*********Second Function in Second Workbook************

Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ThisWs As Worksheet
Dim value1 As String
Dim value2 As String
Set ThisWs = Workbooks("MasterDataFile").Worksheets("DATA")

t = ThisWs.Range("D65536").End(xlUp).Row 'end
'Application.ScreenUpdating = False

'The following 6 lines creates a new column and populates
'    each row with the part number and revision combined.  
Cells(1, 24) = "Order"
For s = 2 To t
    value1 = Cells(s, 4)
    value2 = Cells(s, 11)
    ThisWs.Cells(s, 24) = value1 + "Rev" + value2
Next s

'The following was generated by recording a macro, and uses
'    the filter to organize the data.  The error is occurring
'    because the columns are not being selected.  Why?
ThisWs.Columns("D:X").Select
Selection.AutoFilter
ThisWs.AutoFilter.Sort.SortFields.Clear
ThisWs.AutoFilter.Sort.SortFields.Add Key:=Range( _
    "X1:X19519"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ThisWs.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'This turns off the filter
ThisWs.Range("A1").Select
ThisWs.Columns("D:X").Select
Selection.AutoFilter
ThisWs.Range("A1").Select

'This deletes the generated column after it has been sorted
ThisWs.Columns("X:X").ClearContents
'Application.ScreenUpdating = True

End Sub

有人可以帮助我理解为什么没有选择细胞,有办法解决它吗?

或者,如果所有其他方法都失败了,有人可以发布一种方法来过滤列而不选择任何内容。

谢谢。

2 个答案:

答案 0 :(得分:0)

我已经重建了你的功能,它是未经测试的,应该可以工作,但它没有完全优化。所有内容都在原始函数中处理,并且在OnClose事件中没有处理任何内容。

'*********First Function************
Sub AddDrawing_Button() 'activated by button in worksheet
    Dim wbMasterDataFile as Workbook
    Dim shtData as Worksheet
    Dim t as long
    Dim s as long


    'PN = Sheets("New Drawing").Range("C5").Value        'Part Number,    D
    'Rev = Sheets("New Drawing").Range("C7").Value       'Revision,       E

    Application.ScreenUpdating = False

    set wbMasterDataFile = Workbooks.Open ("C:\Users\Desktop\MasterDataFile.xlsm") 'Finds the file
    set shtData =  wbMasterDataFile.Worksheets("DATA")

    with shtData
        t = .Range("D65536").End(xlUp).Row + 1 'finds the bottom row + 1

        .Range("D1").Cells(t, 1).Value = Sheets("New Drawing").Range("C5").Value                'Part Number,    D
        .Range("K1").Cells(t, 1).Value = Sheets("New Drawing").Range("C7").Value              'Revision,       E

        .Cells(1, 24).Value2 = "Order"

        For s = 2 To t
            .Cells(s, 24) = .Cells(s, 4) + "Rev" + .Cells(s, 11)
        Next s

        .Columns("D:X").AutoFilter
        With .AutoFilter.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("X1:X19519"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        .Columns("D:X").AutoFilter

        .Columns("X:X").ClearContents
    End with

    set shtData = nothing

    wbMasterDataFile.Close SaveChanges:=True

    set wbMasterDataFile = Nothing

    'upon closing this file, it jumps to the following code
    Application.ScreenUpdating = True
End Sub

我还通过Cell函数

对您使用的范围进行了更直接的引用

我必须运行,因此无法解释更多内容,但稍后会更详细地进行编辑。

答案 1 :(得分:0)

感谢@Bullfrog为我提供了解决我问题的方法,我只发布这个,因为我不希望其他vba用户挂起可能无法运行的代码。

Sub AddDrawing_Button()
Dim ThisWb As Workbook, wbMasterDataFile As Workbook
Dim ThisWs As Worksheet, shtData As Worksheet
Dim t As Long, s As Long
Dim value1 As String, value2 As String

Application.ScreenUpdating = False

Set ThisWb = Workbooks("CombinationIndex")
Set ThisWs = ThisWb.Worksheets("New Drawing")

Set wbMasterDataFile = Workbooks.Open("C:\Users\Desktop\MasterDataFile.xlsm")
Set shtData = Workbooks("MasterDataFile").Worksheets("FinalDATA")

With shtData
    t = .Range("D65536").End(xlUp).Row + 1 'Finds the bottom row

    .Range("D1").Cells(t, 1).Value = ThisWs.Range("C5").Value  'Part Number,   D
    .Range("D1").Cells(t, 8).Value = ThisWs.Range("C13").Value  'Revision   ,  E

    .Cells(1, 24).value2 = "Order" 'header to new column

    For s = 2 To t
        value1 = .Cells(s, 4)  'originally Bullfrog's code was giving me an error due to a type mismatch
        value2 = .Cells(s, 11) 'I defined a variable above, and filled it so that it was always a string
        .Cells(s, 24) = value1 + "0Rev" + value2 'will use the combined values to sort data by latest rev
    Next s

    .Columns("D:X").AutoFilter 'using the with function to apply the filter
    With .AutoFilter.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("X1:X19519"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    .Columns("D:X").AutoFilter 'Turns off the filter

    .Columns("X:X").ClearContents 'deletes the data
End With

Set shtData = Nothing

wbMasterDataFile.Close SaveChanges:=True 'closes the file

Set wbMasterDataFile = Nothing

Application.ScreenUpdating = True
End Sub