Question

我是VBA的新手，试图创建一个将文本复制到右边的下一个空单元格并将文本中的任何数字加1的子程序。意外的结果。有人可以告诉我我哪里出问题了吗？感谢您的所有投入

Sub runheading()
    Dim i  As Integer
    Dim j As Integer
    Dim text As String, str As String

    Worksheets("Sheet1").Activate
    Range("a1").Select
    Selection.End(xlToRight).Select
    Selection.Offset(0, 1).Select
    Selection.Font.Bold = True
    Selection.ColumnWidth = 64
    Selection = Selection.Offset(0, -1)

    text = Selection
    For i = 1 To Len(text)
        If Not IsNumeric(Mid(text, i, 1)) Then
            str = str & Mid(text, i, 1)
        End If
    Next i

    For j = 1 To Len(text)
        If IsNumeric(Mid(text, i, 1)) Then
            j = Mid(text, i, 1)            
        End If
    Next j

    Selection = str & (j + 1)
End Sub

Answer 1

编辑

仅添加了文本搜索。

Private Sub runheading()


  Dim row As Integer
  Dim column As Integer

  column = 1
  row = 1


  Do While column < 10

    'first find the free cell to the right
    Do Until IsEmpty(Worksheets("Sheet1").Cells(row, column))
        column = column + 1
        Loop

    'After that take the further left cell Value and write it into the targeted empty cell
  Dim text As String
  Dim str As String
  Dim i As Integer
  Dim number As Integer
      text = Worksheets("Sheet1").Cells(row, column - 1).Value

      For i = 1 To Len(text)
        If IsNumeric(Right(text, i)) Then
            number = Right(text, i)
            str = Left(text, Len(text) - i)
        Else: End If
        Next i


      Worksheets("Sheet1").Cells(row, column).Value = str & (number + 1)

    Loop

End Sub

希望它可以为您提供帮助

Excel VBA-在单元格之间复制文本并修改文本

1 个答案: