Question

我创建了以下循环来搜索以“R”开头的任何值加上一个长度为10个字符的特殊字符，并将它们粘贴到另一个工作表上第1列的下一个空白单元格中。我现在需要开发此代码以复制在sheet2上以R开头的任何值并将它们粘贴到sheet1上的第1列（A）中并复制以sheet2上的数字开头的任何值并将它们粘贴到sheet1上的第4列（D）中< / p>

“R”值将与数值相关联。例如，在Sheet2 A1上可以是R000000_01和B1（如果存在一个值）可能是12345，这两个需要被复制到A3和D3中，如上所述

这是我到目前为止所创造的：

EnvRange = "A2:R999"

RowNo = 3
For Each C In Worksheets("Sheet2").Range(EnvRange)
If Len(C.Value) < 10 Then
GoTo NextCell
ElseIf Len(C.Value) < 11 Then
Worksheets("Sheet1").Cells(RowNo, 1).Value = C
RowNo = RowNo + 1
Else
Chars = InStr(1, C, "R")
Do While Chars < Len(C)
Worksheets("Sheet1").Cells(RowNo, 1).Value = Mid(C, Chars, 10)
Chars = InStr(Chars + 9, C, "R")
RowNo = RowNo + 1
If Chars = 0 Then GoTo NextCell

Loop
End If

NextCell: Next C

非常感谢您对此事的帮助。提前谢谢。

Answer 1

您可以使用Like检查格式：

Sub Tester()

    Const ENV_RNG As String = "A2:R999"

    Dim c As Range, RowNo As Long, sht As Worksheet

    Set sht = Worksheets("Sheet1")
    RowNo = 3

    For Each c In Worksheets("Sheet2").Range(EnvRange)
        If c.Value Like "R?????????" Then
            sht.Cells(RowNo, 1).Value = c.Value
            sht.Cells(RowNo, 4).Value = c.Offset(0, 1).Value
            RowNo = RowNo + 1
        End If
    Next c

End Sub

循环显示工作表2并将特定值复制到工作表1上的指定列

1 个答案: