VBA命令button添加工作表避免重复名称

我创build了一个button，添加新的工作表（“报表”），然后从原始工作表（“数据”）中提取一些数据，但添加新的工作表时。 我发现它不是用户友好的，因为它只能一次生成一个新的报告。 当我添加/创build报告时按下button时，会给我一个错误，如“工作表名称重复”。 此外，我不希望我的用户手动删除旧的产生一个新的。 我不知道如何在我的代码中工作。 另一方面，我不确定使用删除方法来解决这个问题，或添加一个新的工作表，每次按下生成button，如报告1，报告2，报告3 …….如果我想添加其中一个function，我应该添加在我的原始代码中？

Private Sub CommandButton3_Click() Dim rng As Range Dim ss As Range, cel As Range Dim yesno As Range Dim lastrow As Long //looking for the last row of the data Dim tws As Worksheet Dim tlr, i& Set wks = Sheets("Data") With wks lastrow = .Range("A3").End(xlDown).Row Set yesno = .Range("AX3:AX" & lastrow) Set tws = Worksheets.Add(after:=Sheets(Worksheets.Count)) tws.Name = ("report") //fetch the first row as the title Set rng = Union(.Range("B1"), .Range("F1"), .Range("G1"), .Range("H1"),.Range("N1"), .Range("O1"), .Range("Q1"), .Range("U1"), .Range("W1")) rng.Copy tws.Range("A1") //fetec the data with condition For Each ss In yesno If LCase(ss.Cells.Value) = "Yes" And LCase(ss.Cells.Offset(0, -31).Value) = "Trigger" And LCase(ss.Cells.Offset(0, -47).Value) = "Trigger" Then Set rng = Union(.Range("B" & ss.Row), .Range("F" & ss.Row), .Range("G" & ss.Row), .Range("H" & ss.Row), .Range("N" & ss.Row), .Range("O"& ss.Row), .Range("Q" & ss.Row), .Range("U" & ss.Row), .Range("W" & ss.Row)) tlr = tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Row rng.Copy tws.Cells(tlr, "A") ElseIf LCase(ss.Cells.Value) = "No" Then End If Next End With End Sub 

Answer 1

这应该会对你有所帮助 我宣布了一个数组，其中存储了所有报告的数字。 然后find数组的最大值并将其设置为下一个报告编号。 如果没有报告，则创build“report1”。 请询问您是否有任何关于代码的问题。

 Private Sub CommandButton3_Click() Dim rng As Range Dim ss As Range, cel As Range Dim yesno As Range Dim lastrow As Long Dim tws As Worksheet Dim tlr, i& Dim ws As Worksheet 'we will use it for a loop Dim reportNum() As Long 'it's an array to gather all reports' numbers ReDim reportNum(1 To 1) As Long Dim reportExists As Long Set wks = Sheets("Data") With wks lastrow = .Range("A3").End(xlDown).Row Set yesno = .Range("AX3:AX" & lastrow) Set tws = Worksheets.Add(after:=Sheets(Worksheets.Count)) 'A loop through each worksheet to check existence of "report" sheet. If so, it determines number of the last report For Each ws In Sheets If Left(ws.Name, 6) = "report" Then reportExists = True reportNum(UBound(reportNum)) = Mid(ws.Name, 7) ReDim Preserve reportNum(1 To UBound(reportNum) + 1) As Long End If Next ws If reportExists = True Then nextReport = Application.WorksheetFunction.Max(reportNum()) + 1 tws.Name = "report" & nextReport Else tws.Name = "report1" End If Set rng = Union(.Range("B1"), .Range("F1"), .Range("G1"), .Range("H1"), .Range("N1"), .Range("O1"), .Range("Q1"), .Range("U1"), .Range("W1")) rng.Copy tws.Range("A1") For Each ss In yesno If LCase(ss.Cells.Value) = "Yes" And LCase(ss.Cells.Offset(0, -31).Value) = "Trigger" And LCase(ss.Cells.Offset(0, -47).Value) = "Trigger" Then Set rng = Union(.Range("B" & ss.Row), .Range("F" & ss.Row), .Range("G" & ss.Row), .Range("H" & ss.Row), .Range("N" & ss.Row), .Range("O" & ss.Row), .Range("Q" & ss.Row), .Range("U" & ss.Row), .Range("W" & ss.Row)) tlr = tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Row rng.Copy tws.Cells(tlr, "A") ElseIf LCase(ss.Cells.Value) = "No" Then End If Next End With End Sub 

Answer 2

这应该快速满足您的所有需求：

 Private Sub CommandButton3_Click() Dim rng As Range, ss As Range Dim tws As Worksheet Dim chkRng As Variant Dim a(100) As Boolean With Sheets("Data") For Each tws In Sheets If InStr(1, tws.Name, "report", 1) = 1 Then If Len(tws.Name) = 6 Then a(0) = True Else If isnumerc(Mid(tws.Name, 7)) Then a(CByte(Mid(tws.Name, 7))) = True End If End If Next ws Set tws = Worksheets.Add(, Sheets(Worksheets.Count)) 'get the first possible name If Application.Match(False, a, 0) = 1 Then tws.Name = "Report" Else tws.Name = "Report " & Application.Match(False, a, 0) - 1 'fetch the first row as the title Union(.Range("B1"), .Range("F1:H1"), .Range("N1:O1"), .Range("Q1"), .Range("U1"), .Range("W1")).Copy tws.Range("A1") 'fetch the data with condition chkRng = .Range("A1:AX" & .Range("A3").End(xlDown).Row).Value For a = 3 To .Range("A3").End(xlDown).Row If LCase(chkRng(a, 3)) = "trigger" And LCase(chkRng(a, 19)) = "trigger" And LCase(chkRng(a, 50)) = "yes" Then With .Rows(a) If rng Is Nothing Then Set rng = Union(.Columns("B"), .Columns("F:H"), .Columns("N:O"), .Columns("Q"), .Columns("U"), .Columns("W")) Else Set rng = Union(rng, .Columns("B"), .Columns("F:H"), .Columns("N:O"), .Columns("Q"), .Columns("U"), .Columns("W")) End If End With End If Next rng.Copy tws.Cells(tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Row, "A") End With End Sub 

我至less有一个问题： LCase(ss.Cells.Value) = "Yes"怎么可能是真的？ 您的 “是”包含大写字母…您的“触发器”检查…
但是，如果您有任何问题，只要问:)

Answer 3

那么我强烈build议不要使用sheetname（例如在Excel中显示的内容），而是使用代号。 用户可以通过单击选项卡来更改工作表名称。 Codename只能在VBA中更改。

只要将“Sheet1”，“Sheet2”等改为可以帮助你看到什么的东西。 我喜欢把我的codenam放在大写字母，所以我很清楚我在用什么。 在你的情况下，这样的事情。 如果您没有看到左侧的底部窗格，请在select任何页面后按“F4”。 这是在你的VBA编辑器左边，在“（Name）”旁边，应该说SheetX，replace为“REPORT”：

现在，你可能不想重构所有的代码 – 所以我已经稍微编辑过，所以你仍然可以使用它。 唯一的变化（在屏幕截图中显示的使用代号名字）在#################部分之间：

 Dim rng As Range Dim ss As Range, cel As Range Dim yesno As Range Dim lastrow As Long Dim tws As Worksheet Dim tlr, i& Set wks = Sheets("Data") With wks lastrow = .Range("A3").End(xlDown).Row Set yesno = .Range("AX3:AX" & lastrow) '########### Don't need that anymore ############# ' Set tws = Worksheets.Add(after:=Sheets(Worksheets.Count)) ' tws.Name = ("report") '########### We replace by that below ############# REPORT.Cells.Clear Set tws = REPORT '################### All the rest stays the same ########## 'fetch the first row as the title Set rng = Union(.Range("B1"), .Range("F1"), .Range("G1"), _ .Range("H1"), .Range("N1"), .Range("O1"), .Range("Q1"), .Range("U1"), _ .Range("W1")) rng.Copy tws.Range("A1") '//fetec the data with condition For Each ss In yesno If LCase(ss.Cells.Value) = "Yes" And LCase(ss.Cells.Offset(0, -31).Value) = "Trigger" And LCase(ss.Cells.Offset(0, -47).Value) = "Trigger" Then Set rng = Union(.Range("B" & ss.Row), .Range("F" & ss.Row), .Range("G" & ss.Row), .Range("H" & ss.Row), .Range("N" & ss.Row), .Range("O"& ss.Row), .Range("Q" & ss.Row), .Range("U" & ss.Row), .Range("W" & ss.Row)) tlr = tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1).Row rng.Copy tws.Cells(tlr, "A") ElseIf LCase(ss.Cells.Value) = "No" Then End If Next End With 

所以实质上，我只是清除现有的报告表（而不是删除），然后在表格中复制报告。