我们的程序无法正常运行。我们需要在“/”或两个符号“/”之间从C列到新G列的程序复制值

Question

我们需要在“/”之后或两个符号“/”之间从C列到新的G列进行程序复制值。 我们的程序无法正常运行。

Sub Copyvalue()

Dim lookfor As String
Dim i As Integer
Dim j As Integer
Dim cellval As String

lookfor = "/1"

For j = 1 To 20
    For i = 1 To 2000
    
        cellval = Left(Cells(i, j).Value, 4)
        
        If cellval = lookfor Then
            Cells(i, j).Copy Worksheets("sheet").Cells(i, j + 1)
        End If
    
    Next i
Next j

End Sub

`

我们需要在“/”之后或两个符号“/”之间从C列到新的G列进行程序复制值。 我们的程序无法正常运行。

Answer 1

如果我猜对了，你的代码的修复可能看起来像这样

Sub Copyvalue()

    Dim lookfor As String
    Dim i As Integer
    Dim j As Integer
    Dim cellval As Variant

    lookfor = "/"

    For j = 1 To 20
        For i = 1 To 2000
    
           ' Split the string into an array
           cellval = Split(Cells(i, j).Value, lookfor)

            ' In case there is no lookfor in the cell
            ' the next line of the code would error out 
            On Error Resume Next  

            ' in case there is a lookfor in the string
            ' the second item of the array will contain
            ' what you are after
            Worksheets("sheet").Cells(i, j + 1) = cellvalue(1)

            ' reset error handling
            On Error GoTo 0
        
        Next i
    Next j

End Sub

进一步阅读拆分