VBA命令按钮添加工作表,避免重复名称

时间:2015-12-13 16:59:02

标签: excel vba excel-vba

我创建了一个按钮,它将添加一个新的工作表(“报告”)并从原始工作表中提取一些数据(“数据”),但是添加了新的工作表。我发现它不是真正的用户友好,因为它只能生成一次新的报告。当我添加/创建报告时按下按钮,它会给我一个错误,如“工作表名称重复”。另外,我不希望我的用户手动删除旧的用户来生成新的。我不确定它在我的代码中是如何工作的。另一方面,我不确定使用删除方法来解决此问题或添加具有不同名称的新工作表,每次按下生成按钮时,如报表1,报表2,报表3 ....... 如果我想添加其中一个函数我应该在原始代码中添加什么?

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

3 个答案:

答案 0 :(得分:3)

这应该能够快速满足您的所有需求:

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

我至少有一个问题:LCase(ss.Cells.Value) = "Yes"怎么可能是真的? 您的“是”包含大写...所以您检查“触发器”...
但是,如果您有任何疑问,请询问:)

答案 1 :(得分:2)

那应该对你有所帮助。我宣布了一个数组,我们在其中存储所有报告的数字。然后它找到数组的最大值并将其设置为下一个报告编号。如果没有报告,则会创建“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

答案 2 :(得分:1)

我强烈建议不要使用工作表名称(例如Excel中显示的内容),而是使用代号。用户只需单击选项卡即可更改的工作表名称。代号你只能在VBA中改变。

只需将“Sheet1”,“Sheet2”等更改为有助于您了解其内容的内容。我喜欢把我的codenam放在帽子里,所以我很清楚我在使用什么。在你的情况下,这样的事情。如果您没有看到左侧的底部窗格,请在选择任何工作表后按“F4”。这是在你的VBA编辑器左侧,“(名称)”旁边应该说是SheetX,替换为“REPORT”:

enter image description here

现在,您可能不想重构所有代码 - 因此我进行了轻微编辑,因此您仍然可以使用它。唯一的变化(使用屏幕截图中显示的Codename)是在#################部分之间:

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

所以从本质上讲,我只是清除现有的报告表(而不是删除),然后在该表中复制报告。