时间戳

首页 > 解决方案 > 增加包含数字和文本的所有单元格值

excel - 增加包含数字和文本的所有单元格值

问题描述

嗨，我正在尝试构建一个宏，该宏可以搜索具有任何值的单元格并将其中的数字加一。

我所有的单元格都有一个文本和数字，例如（电影 1、电影 2、汽车）每个单元格都包含一个名称和一个数字.. 名称可能是一个或两个单词或更多.. 数字并不总是在末尾和它通常是从 0 到 200，但并非所有单元格都有数字。

这些单元格遍布工作表，我希望宏搜索其中有价值的任何内容并将数字与文本分开，然后将数字加一。

经过数小时的反复试验，我找到了这段代码：

 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

现在的问题是此代码只能应用于一个指定的单元格。

标签： excelvba

解决方案

由于直接使用 excel 单元格会减慢您的执行时间（当要检查大量单元格时），使用数组将是关键：

Option Explicit
Sub IncreaseCellValue()

    Dim arr As Variant
    'This will hold your whole worksheet. Change the sheet name
    arr = ThisWorkbook.Sheets("SheetName").UsedRange.Value

    Dim i As Long, j As Long
    For i = 1 To UBound(arr) 'for every row
        For j = 1 To UBound(arr, 2) 'for every column
            Select Case True
                Case arr(i, j) = vbNullString
                Case arr(i, j) Like "*MyWord*" 'beware Like is Case Sensitive
                Case Else
                    arr(i, j) = AddOne(arr(i, j))
            End Select
        Next j
    Next i

    'Paste you array back to the worksheet
    ThisWorkbook.Sheets("SheetName").UsedRange.Value = arr

    'Note this will paste only values, so if you have formulas they will disappear

End Sub
Private Function AddOne(Value As Variant) As Variant

    Dim MySplit As Variant
    MySplit = Split(Value, " ")
    Dim i As Long
    For i = LBound(MySplit) To UBound(MySplit)
        If IsNumeric(MySplit(i)) Then
            AddOne = AddOne & " " & MySplit(i) + 1
        Else
            AddOne = AddOne & " " & MySplit(i)
        End If
    Next i
    AddOne = Trim(AddOne)

End Function

推荐阅读