[英]Create New Dynamic Sheet based on Column
我正在尝试制作一个新表格,其中只有想要基于主要联系表格做广告的广告商。
我的工作表是这样设置的:
Customer Add1 Add2 City/State/Zip Mailed Phone Called Advertising
其中广告栏是 Y 或 N。我想要做的是有一个新表,其中包含每个在其广告栏中有 y 的广告商。
如果工作表 1 在广告列中包含 Y,我已经让它在新工作表中显示客户,但我必须将公式向下拖动,然后为具有 Ns 而不是 Ys 的行留出大量空格。 我是 VBA 的新手,如果我必须这样做,我什至不知道从哪里开始。
我试图在一个单独的工作表上跟踪他们想要什么样的广告,这样我的主工作表上就没有更多的列并且把它弄得乱七八糟。 如果归结为它,我想我可以编写一个 C++ 程序来做到这一点,但我想将它保留在 excel 中。
我已经查看了此处的一些代码,但我不知道如何将其操作为我需要的。
编辑这就是我现在为我工作的内容,我将两个解决方案合二为一:
Sub AdvertisingFilter()
Dim Wb As Workbook
Dim Ws As Worksheet
Dim Wst
Dim rN As Long, c As Long, counter As Long
Set Wb = ThisWorkbook
If e("Advertising") = False Then
With Wb.Sheets
.Add().Name = "Advertising"
End With
End If
Set Ws = Wb.Worksheets("Advertising")
Set Wst = Wb.Worksheets("Customers")
Ws.Cells.Clear
counter = 2 'Assuming you have a Header in your second sheet
With Wst
rN = .Cells(.Rows.Count, 1).End(xlUp).Row 'find last row
For c = 2 To rN
If .Cells(c, 9).Value = "Y" Then 'Copy only if the value in column I is "Y"
.Rows(c).Columns(1).Copy
Ws.Rows(counter).Columns(1).PasteSpecial xlPasteValues
counter = counter + 1
End If
Next
End With
End Sub
Function e(n As String) As Boolean
Dim Wss As Worksheet
e = False
For Each Wss In Worksheets
If n = Wss.Name Then
e = True
Exit Function
End If
Next Wss
End Function
添加并运行这个宏:
Sub CreateAdSheet()
With Sheets("Main Contact").UsedRange
.AutoFilter 8, "Y" ' <~~ Assumed advertising is column 8 (H)
.Copy Sheets.Add().Cells(2, 1)
.AutoFilter
End With
End Sub
下面的代码将检查工作表名称“广告”,如果没有,它将创建一个新的。 它将复制自动过滤器值(广告列上的“Y”)并将其粘贴到广告表中
Option Explicit
Sub Worksheetfilter()
Dim c As Variant
Dim Wb As Workbook
Dim Ws As Worksheet
Dim WsPaste As Worksheet
Dim Columnaddress As Long
Dim Rowaddress As Long
Dim Rng As Range
Dim Rngcopy As Range
Dim Countws As Long
'On Error Resume Next
Set Wb = ThisWorkbook
Set Ws = Wb.Worksheets("sheet1")
With Ws.UsedRange
Set c = .Find("Advertising", LookIn:=xlValues)
If Not c Is Nothing Then
Columnaddress = c.Column
Rowaddress = c.Row
End If
End With
Set Rng = Ws.Columns(Columnaddress)
Countws = WorksheetFunction.CountIf(Rng, "Y")
If Countws >= 1 Then
If e("Adversting") = False Then
With Wb.Sheets
.Add().Name = "Adversting"
End With
End If
Set WsPaste = Wb.Worksheets("Adversting")
WsPaste.Cells.Clear
Ws.AutoFilterMode = False
'Ws.Rows(Rowaddress).AutoFilter Field:=Columnaddress, Criteria1:="Y"
Ws.UsedRange.Rows(Rowaddress).AutoFilter Field:=Columnaddress, Criteria1:="Y"
Set Rngcopy = Ws.UsedRange.SpecialCells(xlCellTypeVisible)
Rngcopy.Copy
WsPaste.Cells(1, 1).PasteSpecial xlValues
Application.CutCopyMode = False
Application.CutCopyMode = True
Ws.AutoFilterMode = False
End If
End Sub
Function e(n As String) As Boolean
Dim Wss As Worksheet
e = False
For Each Wss In Worksheets
If n = Wss.Name Then
e = True
Exit Function
End If
Next Wss
End Function
我希望你知道如何打开 VBA 并插入一个新模块。 将其粘贴到模块中:
Sub test()
Dim ws As Worksheet
Dim rN As Long, c As Long, counter As Long
Set ws = Worksheets(2) 'Change the 2 to the index where the sheet is located, i.e. if it is located in 4th position,
'then change the 2 to 4
counter = 2 'Assuming you have a Header in your second sheet
With ActiveSheet
rN = .Cells(.Rows.Count, 1).End(xlUp).Row 'find last row
For c = 2 To rN
If .Cells(c, 8).Value = "Y" Then 'Copy only if the value in column H is "Y"
.Rows(c).EntireRow.Copy
ws.Rows(counter).EntireRow.PasteSpecial xlPasteValues
counter = counter + 1
End If
Next
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.