Question

我需要创建整个工作簿的副本（因为我想保留其他工作表，格式等），然后删除不等于当前cl.value的数据行。列标题将始终位于第1行中。工作表可以具有不同数量的列（即A：D，A：F，A：G等），最终用户可以选择要拆分的任何列。

引用单元格是可行的，但如果尝试在代码的以下部分中使其动态（基于上述用户选择）：

Workbooks.Open Filename:=FName
            'Delete Rows
            'REFERENCING ACTUAL CELL WORKS
            'Range("A1").AutoFilter 1, "<>" & cl.Value
            'BELOW DOES NOT WORK
            Range(ColHead).AutoFilter 1, "<>" & cl.Value

我得到

运行时错误'1004'：对象'_Global'的方法'Range'失败

下面的完整代码：

Sub DisplayUserFormSplitWb()
UserFormSplitWb.Show
End Sub

Private Sub BtnOK_Click()
Call SplitWbMaster.SplitWbToFiles
End Sub

Private Sub UserForm_Initialize()
Dim SplitOptions As Range
Set SplitOptions = ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlToRight))
SplitWbCol.List = Application.Transpose(SplitOptions.Value)
End Sub

Sub SplitWbToFiles()
   Dim cl As Range
   Dim OrigWs As Worksheet
   Dim Subtitle As String
   Dim ColValue As String
   Dim ColStr As String
   Dim ColNum As Long

   Set OrigWs = ActiveSheet

   ColValue = UserFormSplitWb.SplitWbCol.Value

   Set ColHead = Rows(1).Find(What:=ColValue, LookAt:=xlWhole)
   Set OffCol = ColHead.Offset(1, 0)
   ColStr = Split(ColHead.Address, "$")(1)
   ColNum = ColHead.Column
   If OrigWs.FilterMode Then OrigWs.ShowAllData
   With CreateObject("scripting.dictionary")
      For Each cl In OrigWs.Range(OffCol, OrigWs.Range(ColStr & Rows.Count).End(xlUp))
         If Not .exists(cl.Value) Then
            .Add cl.Value, Nothing
            'Turn off screen and alerts
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            'Create workbook copy
            FPath = "U:\"
            Subtitle = UserFormSplitWb.SplitWbSubtitle.Value
            FName = FPath & cl.Value & "_" & Subtitle & ".xlsx"
            ActiveWorkbook.SaveCopyAs Filename:=FName
            Workbooks.Open Filename:=FName
            'Delete Rows
            'REFERENCING ACTUAL CELL WORKS
            'Range("A1").AutoFilter 1, "<>" & cl.Value
            'BELOW DOES NOT WORK
            Range(ColHead).AutoFilter 1, "<>" & cl.Value

            ActiveSheet.ListObjects(1).DataBodyRange.Delete

             Range(ColHead).AutoFilter
             Range(ColHead).AutoFilter
            'Rename sheet
            ActiveSheet.Name = Left(cl.Value, 31)
            'Refresh save and close
            ActiveWorkbook.RefreshAll
            ActiveWorkbook.Save
            ActiveWorkbook.Close False
         End If
      Next cl
   End With
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   MsgBox "Splitting is complete. Please check your Computer (U:) drive.", vbOKOnly, "Run Macro"
End Sub

Answer 1

对于可能偶然发现此问题的任何人-

我发现使用以下代码可以解决我的问题：

ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlToRight)).AutoFilter ColNum, "<>" & cl.Value

其中：

Dim ColNum As Long
ColNum = ColHead.Column

如何动态更改要过滤的列？

1 个答案: