excel - 过滤每个值,将每个表复制并粘贴到新工作表中
问题描述
我想使用 vba 代码来有序地选择表中的每个值并将它们复制到新工作表中。如图所示,有一个表格,在 F 列中我们有 2 个不同的值(可能超过 2 个)。我需要的是,当我运行宏时,它将选择第一个值,然后将表复制到新工作表中(工作表的名称将基于 F 列中的值,例如 0.55),然后返回并选择第二个值并做同样的事情。我们可能有超过 6-7 个值,所以我不知道如何创建一个循环来自动为所有值执行此操作。我需要在该代码块的末尾添加此过程。因为代码做了一些不同的事情,结果我得到了那个表。
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim x As Workbook
Dim y As Workbook
Dim q As Workbook
'## Open all workbooks first:
Set x = Workbooks.Open("C:\Users\mammadov.ali\Desktop\macros\barkod.xlsx")
Set y = Workbooks.Open("C:\Users\mammadov.ali\Desktop\macros\csv.csv")
Set q = Workbooks.Open("C:\Users\mammadov.ali\Desktop\macros\campaign.xlsx")
'## Clear the workbook first:
Windows("csv.csv").Activate
y.Sheets("csv").Range("A:M").Clear
'## Insert the column in the barkod file:
Windows("barkod.xlsx").Activate
x.Sheets("barkod").Range("F1").EntireColumn.Insert
'## Insert the column header in the barkod file:
x.Sheets("barkod").Range("E1").Offset(0, 1).Value = "Discounts"
'## make the vlookup in barkod file:
With x.Sheets("barkod").Range("F2")
.FormulaR1C1 = "=VLOOKUP(RC[-1], [campaign.xlsx]Sheet1!C[-5]:C[-4], 2, 0)"
.AutoFill Destination:=.Resize(WorksheetFunction.CountA(.Offset(, -1).EntireColumn))
End With
'## deselect the #N/A:
Windows("barkod.xlsx").Activate
x.Sheets("barkod").Range(Sheets("barkod").Range("A1:F1"), Sheets("barkod").Range("A1:F1").End(xlDown)).Select
Selection.AutoFilter
ActiveSheet.Range("A:F").AutoFilter field:=6, Criteria1:="<>#N/A"
'Now, copy what you want from x:
x.Sheets("barkod").Range(Sheets("barkod").Range("A1:F1"), Sheets("barkod").Range("A1:F1").End(xlDown)).Copy
'Now, paste to y worksheet:
y.Sheets("csv").Range("A1").PasteSpecial
解决方案
这个过程应该做你想做的,所以你可以给它一个有意义的名字,并在你现有代码的末尾调用它。它使用高级过滤器创建 F 中唯一项目的列表,然后使用 AutoFilter 循环遍历每个项目以创建新工作表。
Sub Macro2()
Dim r As Range, r2 As Range, ws As Worksheet
Application.DisplayAlerts = False
With Sheets("Sheet1") 'change to suit
Sheets.Add().Name = "Temp"
.Range("F1", .Range("F" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("A1"), Unique:=True
Set r2 = Sheets("Temp").Range("A2", Sheets("Temp").Range("A2").End(xlDown))
For Each r In r2
.Range("A1").CurrentRegion.AutoFilter field:=6, Criteria1:=r
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
.AutoFilter.Range.Copy ws.Range("A1")
ws.Name = r
.Range("A1").CurrentRegion.AutoFilter field:=6
Next r
Sheets("Temp").Delete
.AutoFilterMode = False
End With
Application.DisplayAlerts = True
End Sub
推荐阅读
- javascript - 使用 VueJS 进行表单验证时的 null 值
- python-3.x - 修复了将空列表分配给值“DNA_Sequence”的错误
- java - 类路径资源 [org/quartz/impl/jdbcjobstore/tables_h2.sql] 无法打开,因为它不存在
- chef-infra - 如何覆盖来自另一个配方的通知
- c - 在 8 位 UART 上发送 16 位值
- javascript - 将 Javascript 中的 Ajax 请求处理为 php
- swift - UIViewController 不会取消初始化(mvvm + 协调器)
- angular - instanceof 为子类返回 false
- inkscape - Inkscape:圆形坐标
- ruby-on-rails - Rails:安全会话 Cookie