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

我有一张有两列的纸。列（E）包含来自数据源的ID和名称，列（K）包含从注释部分提取的ID

列E包含有时ID，以B2C开头，有时名称和ID以5开头。列K包含始终以B2C开头的ID。ID B2C的长度通常为11到13位。以5开头的ID长度为8位

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

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

对象变量或未设置块变量

我有一张下面的图片，它显示了最终的结果

---

任何线索都将不胜感激

导致错误消息的问题是缺少工作表对象的

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

---

避免使用工作表变量的另一种方法是将

与

块一起使用：

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

---

编辑：
查找最后使用的行有多种方法，每种方法都有各自的缺点。

UsedRange

和

xlCellTypeLastCell

的一个缺点是，只有在保存/关闭/重新打开工作簿时才会重置它们。可以在中找到更好的解决方案

子比较（）
尺寸r为长，最后一行为长，ws为工作表
设置ws=ThisWorkbook.Sheets（“Sheet1”）
lastrow=LastRowNum（ws）
与ws
对于r=2到最后一行
.Range（“L”&r）.Value=.Range（“E”&r）.Value
如果.Range（“K”&r）.Value=”“，则.Range（“L”&r）.Value=.Range（“K”&r）.Value
下一个r
以
端接头
联系问题的功能
公共函数LastRowNum（工作表形式）长度相同
LastRowNum=1
如果Application.WorksheetFunction.CountA（Sheet.Cells）为0，则
LastRowNum=Sheet.Cells.Find（What:=“*”，LookIn:=xlFormulas，SearchOrder:=xlByRows，SearchDirection:=xlPrevious）。行
如果结束
端函数

这是我的解决方案：

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

是工作表的最后一行。

这必须是VBA吗？可以很容易地用一个细胞公式来实现…是的，想用VBA来实现它。好的。。。您说“如果是5xxx ID或名称，请查看K列”，但第一行的示例从K复制而来。只要K的值不是空的，就应该取它吗？@Mikz-cool问题是可以理解的，到目前为止你做了什么？是的，我会发布代码。但是有一个运行时错误，未设置对象变量或with block变量。它工作正常：）使用

.UsedRange.Rows.Count

定义最后一行确实是一个糟糕的解决方案，您甚至不应该考虑这样做。仅当您从第一行开始工作表时，它才起作用。OP显然是从第一行开始工作表，因为他们在示例代码中从第1行开始循环，并且因为他们的标题在那里，所以它将始终包含数据。。。说它“偶尔起作用”意味着它不会给出可预测的行为，但它是工作表的一个组成部分，可以始终如一地起作用。不管怎样，为了学究的缘故，我已经相应地更新了我的答案。当所有值都被过度写入时，清除列并没有任何作用？@Wolfie-确实如此，但如果您正在调试，它可以帮助您更好地看到正在发生的事情。因为如果您运行它两次，然后进行调试，旧值将保留。

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

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