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

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

列E包含某个时间标识，以B2C开头，有时名称和标识以5开头。列K始终包含以B2C开头的标识。 ID B2C的长度通常是11到13位长。 从5开始的ID的长度是8位长。

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

我通过查找和replace进行了研究。 我看到了一些例子，其中查找的确切名称被赋予，并被replace为给定名称。 我能够形成一个algorithm，但在我的情况下，如何开始使用代码。 下面的代码有一个runn time错误

对象变化或块variables未设置。

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

导致错误消息的问题是您缺less工作表对象的Set语句。 将对象分配给variables时，必须使用Set ，也就是任何有自己方法的东西。 没有方法（ String ， Integer ， Long ， Boolean ，…）的简单数据types不需要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 

---

避免使用工作表variables的替代方法是使用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 

---

编辑 ：
有多种方法可以find最后使用的行，每个行都有其缺点。 UsedRange和xlCellTypeLastCell缺点是它们只有在保存/closures/重新打开工作簿时才会重置。 在这个答案中可以find更好的解决scheme。

 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

这是我的解决scheme：

 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是lngLastRow的最后一行。