excel - 创建新工作表时自动递增文本框值
问题描述
我想让我的文本框值更灵活。因此,当我创建新工作表时,它们的值会按指定的数字递增。
基于此解决方案,我使用了以下代码:
Sub CivBoxNext()
With ActiveSheet
Range("D51").Select
.Shapes("Civils 3").TextFrame2.TextRange.Characters.Text = ActiveCell.Value + 2
Range("D52").Select
.Shapes("Civils 4").TextFrame2.TextRange.Characters.Text = ActiveCell.Value + 2
End With
End Sub
接下来我将其绘制到创建新工作表作为Call
方法的代码中:
Sub Civilssheet()
Dim I As Long
Dim xNumber As Integer
Dim xName As String
Dim xActiveSheet As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Set xActiveSheet = ActiveSheet
xNumber = InputBox("Enter number of times to copy the current sheet")
For I = 1 To xNumber
xName = ActiveSheet.Name
xActiveSheet.Copy After:=ActiveWorkbook.Sheets("Civils2")
ActiveSheet.Name = "Civils" & I + 2
Next
Call CivBoxNext
xActiveSheet.Activate
Application.ScreenUpdating = True
End Sub
它有效,但仅在下一张纸上有效。
之后,我还有另外 3 张纸,编号应该同时改变。
我尝试了另一种选择,例如在创建新工作表时更改目标单元格值,然后从此单元格中输入我的文本框。
我使用了以下代码:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim ws As Worksheet
j = 0
For Each ws In Worksheets
I = ws.Range("D51").Value
If I > j Then
j = I
End If
Next
ActiveSheet.Range("D51").Value = j + 2
End Sub
创建新工作表时如何进行单元格值自动增量?
我应该立即使用传统的 Excel 公式而不是 VBA 吗?
解决方案
这将合并您的潜艇。你能看看它是否满足你的需求吗?
Sub Civilssheet()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("Civils9")
Dim I As Long
Dim xNumber, valCivics, valCivicsFin As Integer
xNumber = InputBox("Enter number of times to copy the current sheet")
On Error Resume Next
' extract highest Civics worksheet number
For I = 1 To ActiveWorkbook.Sheets.Count
If InStr(1, Sheets(I).Name, "Civils") > 0 Then
valCivics = Val(Replace(Sheets(I).Name, "Civils", ""))
If valCivics > valCivicsFin Then valCivicsFin = valCivics
End If
Next
For I = 1 To xNumber
' add worksheet to the end of existing worksheets
ws.Copy After:=Sheets(Application.Sheets.Count)
' name the new worksheet with the highest value + 1
ActiveSheet.Name = "Civils" & I + valCivicsFin
ActiveSheet.Shapes("Civils 3").TextFrame2.TextRange.Characters.Text = ActiveSheet.Cells(51, 4).Value + 2
ActiveSheet.Shapes("Civils 4").TextFrame2.TextRange.Characters.Text = ActiveSheet.Cells(52, 4).Value + 2
Next
Application.ScreenUpdating = True
End Sub