如何用Excel VBA将动态表中合同占位符#替换为递增编号
Excel VBA 合同占位符批量编号功能问题
项目现状
目前基于Excel VBA开发面向用户的数值计算程序,支持用户通过输入完成参数配置,录入的数值可存储在表格中,计算结果也会同步在表格中展示。当前开发进展顺利,已基于Excel VBA完成动态表格的搭建,卡在一个功能点上需要协助解决。
功能需求
当前涉及的问题与表格内的合同条目管理相关:
- 由于录入阶段无法预先确定总合同数量,所有新增合同初始统一使用
#作为占位符展示(该逻辑从开发初始阶段就采用,暂不分配具体合同编号) - 待所有合同条目录入完成后,将表中所有合同位置的
#占位符替换为按顺序递增的连续编号
现有代码逻辑
当前的代码分为窗体按钮交互逻辑、自定义替换方法两部分,具体实现如下:
Private Sub CommandButton1_Click() Dim answer As Integer Dim answer2 As Integer Dim answer3 As Integer Dim vorname As String Dim nachname As String Dim anteil As String Dim Rng As Range Dim sumGesamt As Integer Dim sheet As Worksheet Dim lRows As Long Dim sumEntschaedigung As Integer Dim sumAnteil As Integer Set sheet = Worksheets("Ergebnis") Set Rng = Range("A6:E1000") sumGesamt = Rng.Find(What:="Entschädigung - Gesamt", LookIn:=xlValues).Row sumEntschaedigung = Rng.Find(What:="####", LookIn:=xlValues).Row sumAnteil = Rng.Find(What:="###", LookIn:=xlValues).Row nachname = TextBox1.Value vorname = TextBox2.Value anteil = TextBox3.Value & " %" ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove Range("A7:E7").EntireRow.Copy ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats Application.CutCopyMode = False ActiveCell.Offset(0, 3).Select ActiveCell.Offset(0, -3).Value = vorname & " " & nachname ActiveCell.Offset(0, -1).Value = anteil ActiveCell.Formula = "=C" & ActiveCell.Row & "*" & "D" & sumGesamt ActiveCell.Offset(0, 1).Value = TextBox3.Value & " (Anteil in %) x " & Range("D" & sumGesamt).Value & " (Entschädigung - Gesamt)" Unload Eigentuemer answer = MsgBox("Weiterer Eigentümer?", vbQuestion + vbYesNo + vbDefaultButton2, "Eigentümerteilung") If answer = vbYes Then Eigentuemer.Show Else answer2 = MsgBox("Weiterer Vertrag?", vbQuestion + vbYesNo + vbDefaultButton2, "Weiterer Vertrag?") If answer2 = vbYes Then With sheet lr = sheet.Range("D" & .Rows.Count).End(xlUp).Row Range("D" & sumEntschaedigung).Formula = "=Sum(D" & sumEntschaedigung + 1 & ":" & "D" & lr & ")" & "+" & "B" & sumEntschaedigung Range("C" & sumAnteil).Formula = "=Sum(C" & sumAnteil + 1 & ":" & "C" & lr & ")" End With Vertrag.Show Else With sheet lr = sheet.Range("D" & .Rows.Count).End(xlUp).Row Range("D" & sumEntschaedigung).Formula = "=Sum(D" & sumEntschaedigung + 1 & ":" & "D" & lr & ")" & "+" & "B" & sumEntschaedigung Range("C" & sumAnteil).Formula = "=Sum(C" & sumAnteil + 1 & ":" & "C" & lr & ")" End With FindReplaceAll answer3 = MsgBox("Programm abgeschlossen! Die Datei wird automatisch gespeichert.", vbInformation + vbOKOnly, "Entschädigungsrechner abgeschlossen") ActiveWorkbook.Save End If End If End Sub Sub FindReplaceAll() Dim ws As Worksheet Dim counter As Integer counter = counter + 1 For Each ws In ActiveWorkbook.Worksheets ws.Cells.Replace What:="#", Replacement:=counter Next ws End Sub
存在的问题
目前已新增自定义的FindReplaceAll()方法,原本计划通过Cells.Replace方法将表中的#占位符替换为递增编号,但当前实现完全无法达到预期效果,需要可行的实现方案支持。
内容的提问来源于stack exchange,提问作者Hamza Mehmud
相关产品推荐
相关产品推荐

