增加包含数字和文本VBA的单元格值

我已经试过这个代码，它适用于只包含数字的单元格：

Sub IncreaseCellValue() 'Add 1 to the existing cell value Range("A1").Value = Range("A1") + 1 End Sub 

如果单元格有文本和数字，我该怎么做类似的东西。 例如，我有“苹果1”，我想“增加”单元格文本到“苹果2”，下一次我运行macros“苹果3”。

Answer 1

这是另一种解决这个问题的方法：

 Sub IncreaseCellValue() Dim value As Variant 'Add 1 to the existing cell value If IsNumeric(Range("A1").value) Then Range("A1").value = Range("A1") + 1 Else value = Split(Range("A1").value, " ") Range("A1").value = value(0) & " " & (CInt(value(1)) + 1) End If End Sub 

它将涵盖你在你的问题中提出的两个案例，但并不是你可以投入的每一个场景。

Answer 2

尝试使用以下function

 Sub IncreaseCellValue() 'Add 1 to the existing cell value Range("A1").Value = Replace(Range("A1").Value2, CleanString(Range("A1")), vbNullString) & CInt(CleanString(Range("A1").Value2)) + 1 End Sub 

---

 Function CleanString(strIn As String) As String Dim objRegex Set objRegex = CreateObject("vbscript.regexp") With objRegex .Global = True .Pattern = "[^\d]+" CleanString = .Replace(strIn, vbNullString) End With End Function 

Answer 3

请检查：

 Option Explicit Sub IncreaseCellValue() 'Add 1 to the existing cell value Dim rg As Range Set rg = Cells(Rows.Count, "A").End(xlUp) Range("A1" & ":" & rg.Address).AutoFill Destination:=Range("A1" & ":" & rg.Offset(1, 0).Address), Type:=xlFillDefault End Sub 

Answer 4

或者你可以尝试这样的事情…

 Function GetNumber(ByVal rng As Range) As Long Dim i As Long For i = Len(rng.Value) To 1 Step -1 If IsNumeric(Mid(rng.Value, i, 1)) Then GetNumber = GetNumber & Mid(rng.Value, i, 1) Else Exit For End If Next i End Function Sub IncrementNumber() Dim num As Long num = GetNumber(Range("A1")) Range("A1").Value = Replace(Range("A1").Value, num, num + 1) End Sub