需要复杂的VBA for Excel才能将多个工作表拆分成多个按列数据筛选的其他工作表
需要复杂的VBA for Excel才能将多个工作表拆分成多个按列数据筛选的其他工作表
提问于 2015-12-02 04:58:45
好的，我有一个问题，我有5个工作表(其中一个是筛选器名称的列表)，我需要根据总代理商名称进行筛选，并在新工作簿中创建和新工作表以分发给他们。所有的源工作表数据都来自SQL DB，我希望每次需要发送报告时都能运行此宏。自从我使用VBA以来已经有一段时间了，但我使用记录器记录了使用MS Query获得基础的步骤，但我不知道如何为所有的工作表和分销商组合(总共36个)自动执行这一步骤。这是非常原始的开始
'
' Sort Macro
'
'
Sheets.Add After:=ActiveSheet
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=CNG_POS;UID=brobbin;Trusted_Connection=Yes;APP=Microsoft Office 2013;WSID=BROBBIN-1Q1Z8;DATABASE=CNG_POS;QueryLog_On=Yes;Mu" _
), Array("ltiSubnetFailover=Yes;")), Destination:=Range("$A$1")).QueryTable
.CommandText = Array( _
"SELECT ""Missing_ORDERS>POS_LOOKUP"".""Fiscal Quarter ID"", ""Missing_ORDERS>POS_LOOKUP"".""ERP End Customer Name"", ""Missing_ORDERS>POS_LOOKUP"".""POS End Customer Master Name"", ""Missing_ORDERS>POS_LOOKUP"".""Da" _
, _
"te Booked"", ""Missing_ORDERS>POS_LOOKUP"".""POS DID"", ""Missing_ORDERS>POS_LOOKUP"".""ERP Deal ID"", ""Missing_ORDERS>POS_LOOKUP"".""Claim Authorization Number"", ""Missing_ORDERS>POS_LOOKUP"".""Sales Order Number " _
, _
"Detail"", ""Missing_ORDERS>POS_LOOKUP"".""Bookings Base List"", ""Missing_ORDERS>POS_LOOKUP"".""Bookings Net"", ""Missing_ORDERS>POS_LOOKUP"".""Bookings Quantity"", ""Missing_ORDERS>POS_LOOKUP"".""S" _
, _
"ales Level 1"", ""Missing_ORDERS>POS_LOOKUP"".""Partner Type"", ""Missing_ORDERS>POS_LOOKUP"".""ERP Bill To Customer Name"", ""Missing_ORDERS>POS_LOOKUP"".""Order Status"", ""Missing_ORDERS>POS_LOOKUP"".""Line Creati" _
, _
"on Date"", ""Missing_ORDERS>POS_LOOKUP"".""Order Source"", ""Missing_ORDERS>POS_LOOKUP"".""POS DISTRIBUTOR NAME"", ""Missing_ORDERS>POS_LOOKUP"".""Product ID"", ""Missing_ORDERS>POS_LOOKUP"".""POS Transaction ID"", ""M" _
, _
"issing_ORDERS>POS_LOOKUP"".""POS Trans Date"", ""Missing_ORDERS>POS_LOOKUP"".""Disti to Reseller Sales Order Date"", ""Missing_ORDERS>POS_LOOKUP"".""Invoice Number"", ""Missing_ORDERS>POS_LOOKUP"".""POS Base List P" _
, _
"rice"", ""Missing_ORDERS>POS_LOOKUP"".""Net POS (Validated) - Global"", ""Missing_ORDERS>POS_LOOKUP"".""Discount %"", ""Missing_ORDERS>POS_LOOKUP"".""Parent line ID"", ""Missing_ORDERS>POS_LOOKUP"".""Line ID""" & Chr(13) & "" & Chr(10) & "FROM C" _
, _
"NG_POS.dbo.""Missing_ORDERS>POS_LOOKUP"" ""Missing_ORDERS>POS_LOOKUP""" & Chr(13) & "" & Chr(10) & "WHERE (""Missing_ORDERS>POS_LOOKUP"".""POS DISTRIBUTOR NAME"" Like 'Tech%')" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub我还希望将源表名称保留为工作表名称，或者创建一个新字符串以包括分发者名称。
任何关于如何做到这一点的想法都将非常感激，因为手动操作几乎是不可能的，而且使用MS查询也不是必需的，这只是我可以在复制工作表时确保分销商数据是独立的一种方法。我正在使用excel 2013
回答 1
Stack Overflow用户
发布于 2015-12-04 03:12:29
好的，这是我想出来的，但是我必须为每张纸制作几个版本。在理想的情况下，我会在另一个工作表上将Dim C设置为= values。现在，最后缺少的部分是将生成的工作表保存到新的工作簿中。
Sub ERP_POS()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim bAF As Boolean
Set ws1 = Sheets("ERP_POS")
Set rng = Range("Database")
bAF = ws1.AutoFilterMode
'extract a list of Sales Reps
With ws1
.Columns("P:P").Copy _
Destination:=.Range("X1")
.Columns("X:X").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("Y1"), Unique:=True
r = .Cells(Rows.Count, "Y").End(xlUp).Row
.Columns("X:X").ClearContents
'set up Criteria Area
.Range("X1").Value = .Range("P1").Value
For Each c In .Range("Y2:Y" & r)
'add the rep name to the criteria area
.Range("X2").Value = _
"=""="" & " & Chr(34) & c.Value & Chr(34)
'add new sheet (if required)
'and run advanced filter
If WksExists("ERP_POS" & " " & c.Value) Then
Sheets("ERP_POS" & " " & c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=Sheets("ERP_POS" & " " & c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = "ERP_POS" & " " & c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("X1:X2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
.Select
.Columns("Y:X").EntireColumn.Delete
If bAF = True Then
.Range("A1").AutoFilter
End If
End With
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/34030012
复制相关文章
相似问题
腾讯云开发者
