我正在创建一个代码,用于打开另一个文件,执行一些操作并关闭它。在我打开的文件中,有一个函数可以在关闭时组织数据。
我不知道如何在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
有人可以帮助我理解为什么没有选择细胞,有办法解决它吗?
或者,如果所有其他方法都失败了,有人可以发布一种方法来过滤列而不选择任何内容。
谢谢。
答案 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