Question

我知道这个问题已经问过，但这里有一些不同的情况。

所以我想从整个textarea中搜索整数。如果找到，那么检查它是否有小于2的小数（例如，如果numberfound = 13.656然后四舍五入到13.66 ），如果没有则将其整理掉。

所以如果在一个textarea中有一个以上的整数，那么它应该检查所有这些。

当我尝试编写用于查找特定字符或数字的代码时。但我没有得到它如何找到整数（意味着从0到9）。

以下是我查找指定字符的代码：

Sub FindNumber()
Dim oSld As Slide
Dim oShp As Shape
Dim oShapes As Shapes
Dim TxtRng as variant 
Dim foundText as variant
Dim no(10) As Variant

For Each oSld In ActivePresentation.Slides
    Set oShapes = oSld.Shapes
    For Each oShp In oShapes
        If oShp.HasTextFrame Then
            If oShp.HasTextFrame Then
                Set TxtRng = oShp.TextFrame.TextRange
                Set foundText = TxtRng.Find(Findwhat:="0")
                sno = oSld.SlideNumber
                Do While Not (foundText Is Nothing)

                    With foundText

                        Set foundText = _
                        TxtRng.Replace(Findwhat:="0",After:=.start + .length -1 )
                    End With
                Loop
            End If
        End If
    Next oShp
Next oSld
End Sub

有没有办法做同样的事。

由于

Answer 1

这实际上是一个评论而不是答案，但评论不允许代码格式化，所以我们在这里。这部分不太正确：

For Each oShp In oShapes
    If oShp.HasTextFrame Then
        If oShp.HasTextFrame Then
            Set TxtRng = oShp.TextFrame.TextRange

相反，它应该是：

For Each oShp In oShapes
    If oShp.HasTextFrame Then
        ' This is the change:
        If oShp.TextFrame.HasText Then
            Set TxtRng = oShp.TextFrame.TextRange

Answer 2

我没有仔细检查过您的代码但是因为您正在搜索“0”而无法正常工作。数字不必包含零。

下面我给出一个函数，它接受一个字符串并返回它，并根据需要舍入数字。在你的代码中调用它。

我包含我的测试数据。我建议您将文本框中的文本复制到此测试例程中。

Option Explicit
Sub TestRound()

  Debug.Print RoundNumbersInText("abcd efghi jklm nopq")
  Debug.Print RoundNumbersInText("ab.cd 1.23 jklm 1.2345")
  Debug.Print RoundNumbersInText("abcd 1.2345 jklm 1.2345")
  Debug.Print _
      RoundNumbersInText("1.2397 jklm 1.2397abcd 1.23.97 jklm 1.2397")
  Debug.Print RoundNumbersInText("abcd 12,345.2345 jklm 1234,5.2345")
  Debug.Print RoundNumbersInText("-1.2345 jklm 1.2345+")
  Debug.Print RoundNumbersInText("abcd -1.2345- jklm +1.2345+")
  Debug.Print RoundNumbersInText(".2345 jklm .23")
  Debug.Print RoundNumbersInText("abcd 1.23.97 jklm .1.2397abcd ")
  Debug.Print RoundNumbersInText("1.234,5 jklm 1.23,45 jklm 1.23,45,")

End Sub
Function RoundNumbersInText(ByVal InText As String) As String

  Dim ChrCrnt As String
  Dim LenInText As Long
  Dim NumberFound As Boolean
  Dim NumberStg As String
  Dim OutText As String
  Dim PosCrnt As Long
  Dim PosDecimal As Long
  Dim PosToCopy As Long

  PosToCopy = 1       ' First character not yet copied to OutText
  PosCrnt = 1
  LenInText = Len(InText)
  OutText = ""

  Do While PosCrnt <= LenInText
    If IsNumeric(Mid(InText, PosCrnt, 1)) Then
      ' Have digit.  Use of Val() considered but it would accept
      ' "12.3 456" as "12.3456" which I suspect will cause problems.
      ' A Regex solution would be better but I am using Excel 2003.
      ' For me a valid number is, for example, 123,456.789,012
      ' I allow for commas anywhere within the string not just on thousand
      ' boundaries.  I will accept one dot anywhere in a number.
      ' You may need to reverse my use of dot and comma.  Better to use
      ' Application.International(xlDecimalSeparator) and
      ' Application.International(xlThousandsSeparator).
      ' I do not look for signs.  "-12.3456" will become "-12.35".
      ' "12.3456-" will become "12.35-". "-12.3456-" will become "-12.35-".
      PosDecimal = 0        ' No decimal found
      If PosCrnt > 1 Then
        ' Check for initial digit being preceeded by dot.
        If Mid(InText, PosCrnt - 1, 1) = "." Then
          PosDecimal = PosCrnt - 1
        End If
      End If
      ' Now review following characters
      PosCrnt = PosCrnt + 1
      NumberFound = True        ' Assume OK until find otherwise
      Do While PosCrnt <= LenInText
        ChrCrnt = Mid(InText, PosCrnt, 1)
        If ChrCrnt = "." Then
          If PosDecimal = 0 Then
            PosDecimal = PosCrnt
          Else
            ' Second dot found.  This cannot be a number.
            ' Might have 12.34.5678. Do not want .5678 picked up
            ' so step past character after dot.
            PosCrnt = PosCrnt + 1
            NumberFound = False
            Exit Do
          End If
        ElseIf ChrCrnt = "," Then
          ' Accept comma and continue search.
        ElseIf IsNumeric(ChrCrnt) Then
          ' Accept digit and continue search.
        Else
          ' End of possible number
          NumberFound = True
          Exit Do
        End If
        PosCrnt = PosCrnt + 1
      Loop
      If NumberFound Then
        ' PosCrnt points at the character which ended the number.
        If Mid(InText, PosCrnt - 1, 1) = "," Then
          ' Do not include a terminating comma in number
          PosCrnt = PosCrnt - 1
        End If
        If PosDecimal = 0 Then
          ' Integer.  Nothing to do.  Carry on with search.
          PosCrnt = PosCrnt + 1     ' Step over terminating character
        Else
          ' Copy everything up to decimal
          OutText = OutText & Mid(InText, PosToCopy, PosDecimal - PosToCopy)
          PosToCopy = PosDecimal
          ' Round decimal portion even if less than two digits. Discard
          ' any commas. Round will return 0.23 so discard zero
          OutText = OutText & Mid(CStr(Round(Val(Replace(Mid(InText, _
                       PosToCopy, PosCrnt - PosToCopy), ",", "")), 2)), 2)
          PosToCopy = PosCrnt
          PosCrnt = PosCrnt + 1     ' Step over terminating character
        End If
      Else ' String starting as PosStartNumber is an invalid number
        ' PosCrnt points at the next character
        ' to be examined by the main loop.
      End If
    Else  ' Not a digit
      PosCrnt = PosCrnt + 1
    End If
  Loop
  ' Copy across trailing characters
  OutText = OutText & Mid(InText, PosToCopy)
  RoundNumbersInText = OutText

End Function

使用vba从powerpoint中的文本中查找号码？

2 个答案: