从工作表中选择特定的列进行保存 [英] Select specific columns from worksheet to save

问题描述

第一个过滤器在列M和U之间运行：

strong>

  Sub TokenNotActivated（）
 
'Col H = Laptop  -  Main 
' Col H =桌面
'Col M =是
'Col U =配置
 ThisWorkbook.Sheets（2）.Activate 
 ActiveSheet.Range（A2：Z2）。 
 Selection.AutoFilter字段：= 8，Criteria1：=桌面，运算符：= xlOr，Criteria1：=笔记本电脑 - 主
 Selection.AutoFilter字段：= 13，Criteria1：=是 
 Selection.AutoFilter字段：= 21，Criteria1：=provisioned，运算符：= xlFilterValues 
 
 End Sub 
  

第二个过滤器对F列进行过滤，过滤每个唯一的值

eg

将作为John，Sarah，Frank的过滤器返回。此外，如果在运行第一组过滤器之后没有找到任何一个行，那么它将被跳过。负责的代码如下：

  Sub GetPrimaryContacts（）
 
 Dim Col As New Collection 
 Dim itm 
 Dim i As Long 
 Dim CellVell As Variant 
 
'获取最后一行值
 LastRow = Cells.SpecialCells（xlCellTypeLastCell）.Row 
 
'所有行之间循环以获取唯一值
对于i = 3 To LastRow 
 CellVal = Sheets（Master）。Range（F& i）.Value 
 On Error Resume Next 
 Col.Add CellVal，Chr（34）& CellVal& Chr（34）
错误GoTo 0 
下一步i 
 
'创建工作簿 - 令牌未激活
调用TokenNotActivated 
对于每个itm在Col 
 ActiveSheet.Range（A2：Z2）。选择
 Selection.AutoFilter字段：= 6，Criteria1：= itm 
调用TokenNotActivatedProcess 
下一个
 
 ActiveSheet .AutoFilter.ShowAllData 
 
 End Sub 
  

第三件事想要做的是为应用第二个过滤器之后显示的每个结果创建一个保存在C：\Working\中的新电子表格。。一旦应用了第二个过滤器，电子表格就会以某种方式重置，并允许新的过滤过程（见上面的代码）。我一直在玩，以确保我得到正确的数据。通过打印到立即窗口，这是正确的。执行此操作的代码如下：

 运行进程以获取工作簿保存
函数TokenNotActivatedProcess（）
 Dim r As Range，n As Long，itm，FirstRow As Long 
n = Cells（Rows.Count，1）.End（xlUp）.Row 
设置r =范围（A1：A & n）.Cells.SpecialCells（xlCellTypeVisible）
 FirstRow = ActiveSheet.Range（F2）。End（xlDown）.Row 
 itm = ActiveSheet.Range（F& FirstRow） .Value 
如果r.Count  -  2> 0然后Debug.Print itm&  - & r.Count  -  2 
结束功能
  

我现在的问题是 - 如何选择列A，B，C ，D，E，Z从行3到最后一行（应用两个过滤器之后），然后将其保存到外部Excel电子表格中，每次迭代过滤？我只对在立即窗口中产生一个值的输出感兴趣（即有可见细胞可见）。理想情况下，我想让他们使用以下格式：

  TokenNotActivated  -  Sarah  -  110514.xlsx 
 TokenNotActivated  -  John  - 110514.xlsx 
 TokenNotActivated  -  Jack  -  110514.xlsx 
  

解决方案

让我们修改你的函数，并返回一个值：

 函数TokenNotActivatedProcess（）As Boolean 
 Dim r As Range，n As Long，itm，FirstRow As Long，ret as Boolean 
n = Cells（Rows.Count，1）.End（xlUp）.Row 
 Set r = Range（A1 ：A& n）.Cells.SpecialCells（xlCellTypeVisible）
 FirstRow = ActiveSheet.Range（F2）。End（xlDown）.Row 
 itm = ActiveSheet.Range（F& FirstRow）.Value 
如果r.Count  -  2> 0然后
 Debug.Print itm&  - & r.Count  -  2 
 ret = True 
如果
 TokenNotActivatedProcess = ret 
结束函数
  

然后，您可以更改对于Col 循环中的每个itm。而不是调用该函数，只需将其作为布尔逻辑的一部分进行评估，因为它返回一个布尔值，可以这样做。

  Dim ws As Worksheet 
设置ws = ActiveSheet 
 
对于每个itm在Col 
 ws.Range（A2：Z2）。AutoFilter字段： = 6，Criteria1：= itm 
如果TokenNotActivatedProcess然后
 
'Dim wbNew as Workbook 
'设置wbNew = Workbooks.Add 
'
'## ＃添加这里的代码将创建一个新的工作簿
'并将数据复制到新的工作簿。 
'这可能是另一个子程序或函数。 
'
'wbNew.SaveAsC：\\\
ew file.xlsx
'wbNew.Close 
 
结束如果
下一个
  

这个将最终修复，但您依靠激活和选择方法，这在使用多个工作簿时变得非常有问题，如下所述：

如何避免在Excel VBA宏中使用选择

我修改了上面的循环以避免这种情况，但可能还有其他需要修复的地方。

如果您在修改您的代码避免使用激活/选择方法，或者如果在添加新工作簿以复制数据时遇到问题，只需使用当前代码更新您的问题。这不应该是非常困难的。

I am working with a friend on a spreadsheet which we are applying multiple filters to.

The first filter runs across column M and U:

Sub TokenNotActivated()

'Col H = Laptop - Main
'Col H = Desktop
'Col M = Yes
'Col U = provisioned
ThisWorkbook.Sheets(2).Activate
ActiveSheet.Range("A2:Z2").Select
Selection.AutoFilter Field:=8, Criteria1:="Desktop", Operator:=xlOr, Criteria1:="Laptop - Main"
Selection.AutoFilter Field:=13, Criteria1:="Yes"
Selection.AutoFilter Field:=21, Criteria1:="provisioned", Operator:=xlFilterValues

End Sub

The second filter acts against column F, filtering each unique value found in there

e.g.

would return as filters for John, Sarah, Frank. Furthermore if there are no rows to be found for either one of them after the first set of filters is run, then it is skipped. The code responsible for this is below:

Sub GetPrimaryContacts()

Dim Col As New Collection
Dim itm
Dim i As Long
Dim CellVell As Variant

'Get last row value
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

'Loop between all rows to get unique values
For i = 3 To LastRow
    CellVal = Sheets("Master").Range("F" & i).Value
    On Error Resume Next
    Col.Add CellVal, Chr(34) & CellVal & Chr(34)
    On Error GoTo 0
Next i

' Create workbooks - Token Not activated
Call TokenNotActivated
For Each itm In Col
    ActiveSheet.Range("A2:Z2").Select
    Selection.AutoFilter Field:=6, Criteria1:=itm
    Call TokenNotActivatedProcess
Next

ActiveSheet.AutoFilter.ShowAllData

End Sub

The third thing I want to do is create a new spreadsheet saved in C:\Working\ for each of the results shown after the second filter is applied. See once the second filter is applied, the spreadsheet "resets" in a way and to allow for fresh new filtering process (see code above). I've been playing around with to ensure I get the correct data pulled. By printing to the Immediate window and it is all correct. The code that does this is below:

' Run the process to get the workbook saved
Function TokenNotActivatedProcess()
    Dim r As Range, n As Long, itm, FirstRow As Long
    n = Cells(Rows.Count, 1).End(xlUp).Row
    Set r = Range("A1:A" & n).Cells.SpecialCells(xlCellTypeVisible)
    FirstRow = ActiveSheet.Range("F2").End(xlDown).Row
    itm = ActiveSheet.Range("F" & FirstRow).Value
    If r.Count - 2 > 0 Then Debug.Print itm & " - " & r.Count - 2
End Function

My question now is - how do I select columns A,B,C,D,E,Z from row 3 to the last row (after both filters are applied) and then save it to an external Excel spreadsheet with each iteration of the filter process? I'm only interested in outputs that produce a value in the Immediate window (i.e. where there are visible cells to be seen). Ideally I want to have them in the following format:

TokenNotActivated - Sarah - 110514.xlsx
TokenNotActivated - John - 110514.xlsx
TokenNotActivated - Jack - 110514.xlsx

解决方案

Let's modify your function a little bit and have it return a value:

Function TokenNotActivatedProcess() As Boolean
    Dim r As Range, n As Long, itm, FirstRow As Long, ret as Boolean
    n = Cells(Rows.Count, 1).End(xlUp).Row
    Set r = Range("A1:A" & n).Cells.SpecialCells(xlCellTypeVisible)
    FirstRow = ActiveSheet.Range("F2").End(xlDown).Row
    itm = ActiveSheet.Range("F" & FirstRow).Value
    If r.Count - 2 > 0 Then 
        Debug.Print itm & " - " & r.Count - 2
        ret = True
    End If
    TokenNotActivatedProcess = ret
End Function

Then, you can change your For each itm in Col loop. Instead of calling the function, just evaluate it as part of boolean logic, since it returns a boolean, you can do this.

Dim ws As Worksheet
Set ws = ActiveSheet

For Each itm In Col
    ws.Range("A2:Z2").AutoFilter Field:=6, Criteria1:=itm
    If TokenNotActivatedProcess Then

        'Dim wbNew as Workbook
        'Set wbNew = Workbooks.Add
        '
        '### Add code here which will create a new workbook
        '    and copy the data to the new workbook.
        '    This would probably be another subroutine or function.
        '
        'wbNew.SaveAs "C:\new file.xlsx"
        'wbNew.Close

    End If
Next

This will fix it eventually, but you are relying on Activate and Selection methods, which becomes very problematic when you are working with multiple workbooks, as discussed here:

How to avoid using Select in Excel VBA macros

I modified the loop above to avoid this but there may be other places you need to fix.

If you have trouble modifying your code to avoid using Activate/Select methods, or if you have problems adding new workbooks to copy the data, just update your question with your current code. It should not be very difficult to do this.

这篇关于从工作表中选择特定的列进行保存的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！