Question

我有一张有两列的表格。列（E）包含数据源中的ID和名称，列（K）包含ID，这些ID是从注释部分提取的。

列E包含某个时间ID，从B2C开始，有时名称和Id从5开始。列K包含从B2C开始的ID。 ID B2C的长度通常为11到13位长。从5开始的ID长度为8位长。

我想有一个VBA来检查这两列，如果有一个以5开头的id或者列E中的某个名称，那么它应该查看列K，如果存在以B2C开头的ID，那么它应复制到L列，否则将相同的值（从E列）复制到L列。

我通过查找和替换进行了研究。我看到了一些示例，其中给出了确切的查找名称，并替换为给定的名称。我能够形成一个算法，但在我的情况下，如何开始使用代码。下面的代码有一个运行时错误

对象变量或未设置块变量。

Sub compare()

Dim i As Long
Dim ws As Worksheet


ws = Sheets("Sheet1")

For i = 1 To Rows.Count

If ws.Cells(i, 11).Value = "" Then

ws.Cells(i, 12).Value = ws.Cells(i, 5).Value

Else

ws.Cells(i, 12).Value = ws.Cells(i, 11).Value

End If

Next i

End Sub

我在下方有一张图片，显示最终结果。

任何领导都将不胜感激。

Answer 1

导致错误消息的问题是您缺少工作表对象的Set语句。在将对象分配给变量时，必须使用Set，即使用自己的方法。没有方法的简单数据类型（String，Integer，Long，Boolean，...）不需要Set语句，并且可以像i = 0一样直接分配。

您的代码应更新为：

Dim i As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
' RED FLAG! Rows.Count is going to cause you to loop through the entire column,
' see the below example for how to use the UsedRange property.
For i = 1 To Rows.Count 
    If ws.Cells(i, 11).Value = "" Then
        ws.Cells(i, 12).Value = ws.Cells(i, 5).Value
    Else
        ws.Cells(i, 12).Value = ws.Cells(i, 11).Value
    End If
Next I

避免使用工作表变量的替代方法是使用With块：

Dim r As Long
With ThisWorkbook.Sheets("Sheet1")
    For r = 2 To .UsedRange.Rows.Count
        .Range("L" & r).Value = .Range("E" & r).Value
        If .Range("K" & r).Value = "" Then .Range("L" & r).Value = .Range("K" & r).Value
    Next r
End With

修改：
有多种方法可以找到最后使用的行，每个行都有其缺点。 {/ em> UsedRange和xlCellTypeLastCell的缺点是它们仅在您保存/关闭/重新打开工作簿时重置。在this answer中可以找到更好的解决方案。

Sub compare() Dim r As Long, lastrow As Long, ws As WorkSheet Set ws = ThisWorkbook.Sheets("Sheet1") lastrow = LastRowNum(ws) With ws For r = 2 To lastrow .Range("L" & r).Value = .Range("E" & r).Value If .Range("K" & r).Value = "" Then .Range("L" & r).Value = .Range("K" & r).Value Next r End With End Sub ' Function from linked question Public Function LastRowNum(Sheet As Worksheet) As Long LastRowNum = 1 If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then LastRowNum = Sheet.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End If End Function

Answer 2

这是我的解决方案：

Option Explicit

Sub Compare()

    Dim i               As Long
    Dim lngLastRow      As Long
    Dim ws              As Worksheet

    lngLastRow = Range("A1").SpecialCells(xlCellTypeLastCell).Row

    Set ws = Worksheets(1)

    With ws
        .Columns(12).Clear
        .Cells(1, 12) = "Extract from Comment"
        For i = 1 To lngLastRow
            If .Cells(i, 11).Value = "" Then
                .Cells(i, 12).Value = ws.Cells(i, 5).Value
            Else
                .Cells(i, 12).Value = ws.Cells(i, 11).Value
            End If
        Next i
    End With

End Sub

清除列（12）并在行的第一个单元格中写入从评论中提取，以确保一切都干净。 lngLastRow是表格的最后一行。

检查值，比较并复制到另一列

2 个答案: