Question

这是我目前的代码，我从其他人的帖子和建议中收集并修改它以满足我的需求。

'代码的作用

它当前读取表中的值，过滤值以创建唯一列表，它获取这些值并创建一个名为唯一列表的表单，其中包含列表中的这些值。基于该列表，它为表中列出的每个唯一值创建一个工作表。

“的问题

此代码到目前为止效果很好但现在我需要根据这些唯一值添加信息。下面我把评论（'＆gt;我想在这里插入新程序）到我想要放置新程序（它将添加原始数据表中的数据）。以下是我想添加的程序。但是当我运行它时，它会创建比它应该更多的选项卡，然后关闭我的excel。期望的结果是这个添加是使用唯一值转到原始表，根据每个唯一值过滤表并复制某些列中的所有信息，然后将它们粘贴回与刚创建的相关的表中之前为那个特定的价值。

老实说，我认为我在测试过程中有rCell而且不喜欢它。我知道如何获取“原始数据”表并复制信息，但我不知道如何回到上一页。我只是根据其名称调出该表，但我需要它作为循环并运行该列表中的每个唯一值。

任何帮助将不胜感激。我知道很多东西要读。我只是想给你们很多信息来帮助你了解我的项目。

'this is the code i want to insert into my 'Pagesbydescription' macro
'test start
Sheets("Raw Data").Select
Selection.AutoFilter
ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=11,      Criteria1:= _
rCell
Range("A3:J5000").Select
Selection.Copy
Sheets.Select
Range("A3").Select

ActiveSheet.Paste
Columns("A:K").EntireColumn.AutoFit
'test end




Sub PagesByDescription()
'
'PagesByDescription
' 
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("K4", Range("K5000").End(xlUp))

'Delete any sheet called "UniqueList"
'Turn off run time errors & delete alert
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete

'Add a sheet called "UniqueList"
Worksheets.Add().Name = "UniqueList"

'Filter the Set range so only a unique list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True

'Set a range variable to the unique list, less the heading.
Set rRange = .Range("A1", .Range("A5000").End(xlUp))
End With

On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("k1").AutoFilter 1, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText

'> I would like to Insert new procedure here


Next rCell
End With

With wSheetStart
.AutoFilterMode = False
.Activate
End With

On Error GoTo 0
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("NA").Delete
Sheets("BODY").Delete
Sheets("BODY PREBUILD").Delete
Application.DisplayAlerts = True

Answer 1

一些意见：

Sub PagesByDescription（）的上半部分读起来相当令人困惑，但可能有效...你可以非常自由地解释使用With ... End with bracket

第二个With / Foreach建议您想要在表wSheetStart中工作，但此时rRange已经指向唯一列表，因为您在第一个With块中重新定义了它...不确定这是否是意图。

我建议你稍微清理你的代码，这会让你更清楚：

使用缩进
具体说明您的范围的父对象是什么......这一切都很清楚
不要将rRange用于不同目的，投资另一个变量名称

基于列表中的值运行宏

1 个答案: