我创建了一个按钮,它将添加一个新的工作表(“报告”)并从原始工作表中提取一些数据(“数据”),但是添加了新的工作表。我发现它不是真正的用户友好,因为它只能生成一次新的报告。当我添加/创建报告时按下按钮,它会给我一个错误,如“工作表名称重复”。另外,我不希望我的用户手动删除旧的用户来生成新的。我不确定它在我的代码中是如何工作的。另一方面,我不确定使用删除方法来解决此问题或添加具有不同名称的新工作表,每次按下生成按钮时,如报表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
答案 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”:
现在,您可能不想重构所有代码 - 因此我进行了轻微编辑,因此您仍然可以使用它。唯一的变化(使用屏幕截图中显示的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
所以从本质上讲,我只是清除现有的报告表(而不是删除),然后在该表中复制报告。