输出范围与输入范围相同

Question

我有一些使用 VBA 的历史，但似乎找不到这个问题的解决方案。 我找到了一个迭代过程来选择一个单元格，执行一个过程，然后选择下一个单元格并再次执行该过程，直到 NULL。 我在将每个流程解决方案输出到下一列时遇到问题。这是我所拥有的：

Sub Name ()
Dim X As Integer
Dim MyString as String
Application.ScreenUpdating = False
NumRows = Range("D2", Range("D2").End(xlDown)).Rows.Count
Range("D2").Select
For X = 1 To NumRows
    MyString = ActiveCell.Value
    MyString = Right(MyString, Len(MyString)-6)
    Range("I2 to I#").Value = MyString
    ActiveCell.Offset(1,0).Select
Next X
End Sub

Range("I2 to I#").Value = MyString是我需要帮助的线路。 我需要它递增到 I3、I4、I5 等，直到达到 NumRows 计数。

Answer 1

在使用 Cells 时，循环遍历它们的最佳方法是For Each Cell in Range所以拿这个和注释告诉你避免选择，这应该可以帮助你：

Option Explicit
Sub Name()
    Dim C As Range, MyRange As Range
    Dim LastRow As Long
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your working sheet name
        LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 'last row on column D
        Set MyRange = .Range("D2:D" & LastRow) 'declare your working range
        For Each C In MyRange
            If Not C = vbNullString Then .Cells(C.Row, "I") = Right(C, Len(C) - 6)
        Next C
    End With
    Application.ScreenUpdating = True
End Sub

Answer 2

另一种解决方案是Do Until 。如果数据中间没有空单元格，则可以使用此方法。

Option Explicit
Sub Test()
    Dim StartingPoint As Long
    StartingPoint = 2 'Set the line to begin
    With ThisWorkbook.Worksheets("Sheet1") 'Set the worksheet
        Do Until .Cells(StartingPoint, "D").Value = "" 'Repeat the process until you find empty cell
           .Cells(StartingPoint, "I").Value = Right(.Cells(StartingPoint, "D").Value, Len(.Cells(StartingPoint, "D").Value) - 6)
           StartingPoint = StartingPoint + 1
        Loop
    End With
End Sub