【发布时间】：2018-07-13 14:38:38
【问题描述】：
我今天的问题是尝试让一个新的工作表名称在命名时具有两个不同的 cell.values。
当前代码从一个选项卡中获取数据，并根据单元格区域 K7 中的内容创建不同的工作表。因此，每个选项卡都填充了基于 K7 列的数据。目前我在
处设置了新的工作表名称wsnew.name = "NIIN " + cell.value
它的工作并带回标有“NIIN xxxxxxxx”的标签。
我还有另一列标题为“示例”，范围从 A7 开始。
如果该列具有相同的 K7 值，则该列的值都相同。
有没有办法让 VBA 从 A7 和 K7 中找到单元格值并将其添加到工作表名称？
理想情况下，我希望它是这样的
wsnew.name = "Sample " + cell.value (a7 range) + " NIIN " + cell.value (k7 range)
添加提供的代码会给我工作表名称，例如“Sample xxxxxx NIIN”
xxxxx 实际上应该在 NIIN 的前面，以便它读取“Sample..... NIIN xxxxxx”
WSNew.Name = "Sample " & cell.Offset(0, 10).Value & " NIIN " & cell.Value
这是我添加的代码，它将格式切换为“Sample NIIN xxxxxx”
效果很好，但是在 Sample 之后我仍然没有得到价值。
我尝试了cell.offset (O,-10).value，但是这给了我一个错误
下面的代码是工作表命名之前的代码
Set ws2 = Worksheets.Add
With ws2
'first we copy the Unique data from the filter field to ws2
My_Table.ListColumns(FieldNum).Range.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True
'loop through the unique list in ws2 and filter/copy to a new sheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)
'Filter the range
My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _
Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?")
CCount = 0
On Error Resume Next
CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 areas for the value : " & cell.Value _
& vbNewLine & "It is not possible to copy the visible data to a new worksheet." _
& vbNewLine & "Tip: Sort your data before you use this macro.", _
vbOKOnly, "Split in worksheets"
Original sheet with the data and micro
What the code does when cell.value comes after & " NIIN "
我希望这些图片对这个问题有所帮助。
正如您在单击宏时从图片中看到的那样，它会根据 K7 中的标准（即 NIIN 字段）创建许多工作表。
您还可以看到 EY Sample 下的值是我想要在“Sample...”之后的输出中的值
使其显示为（例如）“Sample 5 NIIN 1212”
这是整个代码。我相信有一个更好的方法可以把它写出来。我使用了我所拥有的基本知识和经验。许多人为这造成的头痛道歉
Sub Copy_To_Worksheets()
Dim CalcMode As Long
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim FieldNum As Long
Dim My_Table As ListObject
Dim ErrNum As Long
Dim ActiveCellInTable As Boolean
Dim CCount As Long
'Select a cell in the column that you want to filter in the List or Table
Application.GoTo Sheets("SplitInWorksheets").Range("K7")
If ActiveWorkbook.ProtectStructure = True Or ActiveSheet.ProtectContents = True Then
MsgBox "This macro is not working when the workbook or worksheet is protected", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
End If
Set rng = ActiveCell
'Test if rng is in a a list or Table
On Error Resume Next
ActiveCellInTable = (rng.ListObject.Name <> "")
On Error GoTo 0
'If the cell is in a List or Table run the code
If ActiveCellInTable = True Then
Set My_Table = rng.ListObject
FieldNum = rng.Column - My_Table.Range.Cells(1).Column + 1
'Show all data in the Table/List
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
' Add a worksheet to copy the a unique list and add the CriteriaRange
Set ws2 = Worksheets.Add
With ws2
'first we copy the Unique data from the filter field to ws2
My_Table.ListColumns(FieldNum).Range.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True
'loop through the unique list in ws2 and filter/copy to a new sheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)
'Filter the range
My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _
Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?")
CCount = 0
On Error Resume Next
CCount = My_Table.ListColumns(1).Range.SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 areas for the value : " & cell.Value _
& vbNewLine & "It is not possible to copy the visible data to a new worksheet." _
& vbNewLine & "Tip: Sort your data before you use this macro.", _
vbOKOnly, "Split in worksheets"
Else
Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count))
On Error Resume Next
WSNew.Name = "Sample " & cell.Offset(0, 10).Value & " NIIN " & cell.Value
If Err.Number > 0 Then
ErrNum = ErrNum + 1
WSNew.Name = "Error_" & Format(ErrNum, "0000")
Err.Clear
End If
On Error GoTo 0
'Copy the visible data and use PasteSpecial to paste to the new worksheet
My_Table.Range.SpecialCells(xlCellTypeVisible).Copy
With WSNew.Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
End If
'Show all data in the Table/List
My_Table.Range.AutoFilter Field:=FieldNum
Next cell
'Delete the ws2 sheet
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0
End With
If ErrNum > 0 Then MsgBox "Rename every WorkSheet name that start with ""Error_"" manually" & vbNewLine & _
"There are characters in the Unique name that are not allowed in a sheet name or the sheet exist."
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
Else
MsgBox "Select a cell in the column of the List or Table that you want to filter"
End If
End Sub
【问题讨论】：
-
我无法完全按照您的要求进行操作。您需要使用的不仅仅是“xxxxx”来显示哪些数据应该在哪里。
-
您要我连接 4 个值：
sample + a7 + NIIN + k7但您只在预期的输出"Sample NIIN xxxxxx"中指定了三件事，因此很难理解您的问题到底是什么 -
@Marcucciboy2 我很抱歉。预期的输出应该是“Sample（A7 中的单元格值）NIIN（K7 中的单元格值）”所以它应该是“Sample 1 NIIN 1234567”
-
所以当我提供的代码不起作用时，而不是得到（例如）“Sample A NIIN 1234567”，你只会得到“Sample NIIN 1234567”？
-
@Marcucciboy2 提供了两张图片，一张显示原始工作表，另一张显示宏的作用。