根据特定列中的值将行复制到 wksheet 不适用于我的整个电子表格

荒地

我正在遍历当前工作表 B 列中的值。如果值的长度为 8 个字符，则将整个行复制到另一个工作表。它有点工作，但我错过了大约一百行应该被复制的行。

我想这与 B 列中单元格值的格式有关。有些只是文本标题，肯定不符合条件。它应该复制的都是这种格式（B列）：

6008571X
60088242
....

我感兴趣的行在 B 列中有 8 个字符。问题是它们中的一些可能被格式化为数字，有些可能被格式化为文本（或者可能以 ' 开头）。

Sub aims()
    Dim i As Long
    'Get the address of the first non blank cell in Row B from the bottom
    MyFirstBlankAddress = Range("B1048576").End(xlUp).Offset(1, 0).Address
    'Extract the number from the address to get the row number
    MyRowNumber = Split(MyFirstBlankAddress, "$")(2)

    For i = 1 To MyRowNumber
        With Range("B" & i)
            If Len(.Value) = 8 Then .EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End With
    Next i
End Sub

我期待复制 410 行，而只有 276 行被复制。

编辑：我一直在阅读您的答案/建议和测试内容。我发现问题出在别处。我的原始代码以正确的方式识别行，这与复制有关。

如果我将代码更改为仅突出显示匹配的行，它将匹配所有正确的行：

If Len(.Value) = 8 Then .EntireRow.Interior.Color = 5296274

打

我确定有更好的方法来进行复制/粘贴，这就是您的问题所在，但以下方法有效。

Sub aims()
Dim i As Long
Dim vLastRow As Long
Dim s2 As Long

'find last row in sheet, or you could change to find last row in specified column
'Example: Cells = Columns(column number or letter), Cells(1, 1) = Cells(1, column number)
vLastRow = Cells.Find(what:="*", after:=Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
s2 = 1

Application.ScreenUpdating = False

For i = 1 To vLastRow
    If Trim(Len(CStr(Cells(i, 2)))) = 8 Then
        Rows(i).EntireRow.Copy Destination:=Sheets(2).Range(Cells(s2, 1).Address)
        s2 = s2 + 1
    End If
Next i

Application.ScreenUpdating = True

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。