我今天的问题是试图获得一个新的工作表名称，以便在命名时具有两个不同的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
答案 0 :(得分：2)
在VBA中，您用&字符连接字符串。其次，当您遍历A列时要访问K列，只需执行简单的.Offset(row,col)。
因此您的代码行变为：
WSNew.Name = "Sample " & cell.Value & " NIIN " & cell.Offset(0,10).Value
'SheetName = Sample + A7 + NIIN + K7