VBA排序宏不起作用
VBA排序宏不起作用
排序代码不再起作用了。第一次运行时它是有效的。然后我关闭了它，重新打开后出现了错误。（我没有做任何更改。）它给出了如下错误信息：
错误438：对象不支持此属性或方法
出错行：
DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal`
排序代码片段：
'按字母顺序排序
DataSheet.Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
FNOrdCol = ActiveCell.Address
DataWB.DataSheet.Sort.SortFields.Clear
DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With DataWB.DataSheet.Sort
.SetRange DataSheet.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
完整代码：
Sub iGetData()
Dim ValidatorWB As Workbook
Dim PopDetail As Worksheet
Dim DataSheetName As String
Dim DataWB As Workbook
Dim DataSheet As Worksheet
Dim Ret
Dim DWBName As String
Dim FNOrder As String
Dim FNOrdCol As String
Set PopDetail = Worksheets("PopulateWireframe")
Set ValidatorWB = Workbooks(ActiveWorkbook.Name)
DataSheetName = Range("F18").Value
FNOrder = Range("F33").Value
Application.ScreenUpdating = False
'打开数据文件
Ret = IsWorkBookOpen(PopDetail.Range("C18").Value)
If Ret = False Then
Workbooks.Open PopDetail.Range("C18").Value
DataFileName = ActiveWorkbook.Name
Set DataWB = Workbooks(DataFileName)
Set DataSheet = Worksheets(DataSheetName)
Dim FilterColumn As String
Dim FilterCriteria As String
Dim ColumnNumber As Integer
'设置过滤器
With DataSheet
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
End With
ValidatorWB.Activate
PopDetail.Activate
For x = 21 To 30
If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then
FilterColumn = PopDetail.Range("E" & x).Value
FilterCriteria = PopDetail.Range("F" & x).Value
DataWB.Activate
DataSheet.Activate
DataSheet.Range("A1").Select
Selection.End(xlToLeft).Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ColumnNumber = ActiveCell.Column
DataSheet.AutoFilterMode = False
DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria
End If
ValidatorWB.Activate
PopDetail.Activate
'x = x + 1
Next x
DataWB.Activate
DataSheet.Activate
'按字母顺序排序
DataSheet.Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
FNOrdCol = ActiveCell.Address
DataWB.DataSheet.Sort.SortFields.Clear
DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With DataWB.DataSheet.Sort
.SetRange DataSheet.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'复制数据
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'将数据粘贴到验证工作簿
ValidatorWB.Activate
ValidatorWB.Sheets.Add().Name = "ValidatorData"
ActiveCell.Offset(3, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15
Application.CutCopyMode = False
'DataWB.Close savechanges:=False
If DataWB.Windows(1).Visible = True Then
DataWB.Windows(1).Visible = False
End If
Application.ScreenUpdating = True
PopDetail.Activate
Else
DWBName = GetFilenameFromPath(PopDetail.Range("C18").Value)
Set DataWB = Workbooks(DWBName)
DataWB.Activate
Set DataSheet = Worksheets(DataSheetName)
DataSheet.Activate
With DataSheet
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
End With
ValidatorWB.Activate
PopDetail.Activate
For x = 21 To 30
If Range("E" & x).Value <> "" And Range("F" & x).Value <> "" Then
FilterColumn = PopDetail.Range("E" & x).Value
FilterCriteria = PopDetail.Range("F" & x).Value
DataWB.Activate
DataSheet.Activate
DataSheet.Range("A1").Select
Selection.End(xlToLeft).Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Find(What:=FilterColumn, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ColumnNumber = ActiveCell.Column
DataSheet.AutoFilterMode = False
DataSheet.Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=FilterCriteria
End If
ValidatorWB.Activate
PopDetail.Activate
'x = x + 1
Next x
DataWB.Activate
DataSheet.Activate
'按字母顺序排序
DataSheet.Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Find(What:=FNOrder, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
FNOrdCol = ActiveCell.Address
'DataWB.DataSheet.Sort.SortFields.Clear
DataWB.DataSheet.Sort.SortFields.Add Key:=Range(FNOrdCol), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With DataWB.DataSheet.Sort
.SetRange DataSheet.Cells
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'复制数据
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'将数据粘贴到验证工作簿
ValidatorWB.Activate
ValidatorWB.Sheets.Add().Name = "ValidatorData"
ActiveCell.Offset(3, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 15
Application.CutCopyMode = False
'DataWB.Close savechanges:=False
If DataWB.Windows(1).Visible = True Then
DataWB.Windows(1).Visible = False
End If
Application.ScreenUpdating = True
PopDetail.Activate
End If
End Sub
问题原因：在代码中，DataWB.DataSheet被改为了ActiveSheet，导致出现问题。
解决方法：将代码中的DataWB.DataSheet改为DataWB.Worksheets(DataSheetName)。
解决方法的代码示例：Set DataSheet = DataWB.Worksheets(DataSheetName)。
这个问题的根源在于代码中对于DataSheet的定义不正确。整个宏的代码可以进行重写，但更好的解决方法是将Set DataSheet = Worksheets(DataSheetName)改为Set DataSheet = DataWB.Worksheets(DataSheetName)。为什么会有不同工作簿中具有相同名称的工作表呢？
我的宏从多个工作簿和工作表中复制数据并进行匹配，所以随着深入挖掘，代码会变得混乱。这是我五年来编写的第一段代码，所以肯定存在一些低效之处。VB在一致性要求方面也不太友好。
问题的出现原因可能是由于以下原因之一：
1. FNOrder 变量未正确赋值。
2. DataSheet 对象未正确定义。
3. FNOrder 的值不在 DataSheet 的第一行中。
解决方法可能是：
1. 确保 FNOrder 变量已正确赋值。
2. 确保 DataSheet 对象已正确定义。
3. 检查 FNOrder 的值是否在 DataSheet 的第一行中。
以下是修复代码的建议：
debug.print FNOrder & " is the name of the column to be sorted on"
With DataSheet
With .Cells(1, 1).CurrentRegion
.Cells.Sort Key1:=.Columns(Application.Match(FNOrder, .Rows(1), 0)), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
.Cells.Copy
End With
End With
如果问题仍然存在，可以使用 VBE 的 Immediate 窗口（例如 Ctrl+G）来查看报告的 FNOrder 的值。如果你满意地解决了这个问题，我建议你将其发表在 Code Review (Excel) 上以获得优化建议。
如果你在 "With DataWB.DataSheet" 这一行遇到了 "Object does not support this property or method" 错误，请参考以下修订版代码。同样，检查 VBE 的 Immediate 窗口中报告的值是否在 DataSheet 的第一行中。
请注意，以上是根据提供的信息整理的文章，可能需要根据实际情况进行修改和调整。