遍历工作表 2 并将特定值复制到工作表 1 上的指定列中

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