基于FIND结果在偏移列中插入文本的Excel VBA Compact方法



我正在编写一个小型的时间节省工具,该工具根据C列中基于列表的文本搜索位置的单元格偏移量在列中插入各种文本值。

Dim C1 As Range Set C1 = Range("B:B").Find("Value to search") If C1 Is Nothing Then Else C1.Offset(0, -1).Value = "Text value to insert" End If

我确信有一种更好的方法可以以更可扩展的方式编写这个相对简单的过程,而不是硬编码代码中的每个值来搜索,但我不确定如何进一步简化。我一直在看前两行,我可能错了,但我认为需要将单元格范围定义为写在前两行中,以便偏移量知道要偏移的单元格位置。

这取决于您计划如何运行它。您可以将其作为一个子项,提示用户输入搜索值和要在偏移处输入的文本。我在下面展示。相反,如果您在工作表中有搜索和偏移字符串,那么很容易适应循环。我只使用B列的填充区域进行搜索。搜索值和插入/偏移值保存在变量中。

Option Explicit
Public Sub AddText()
Dim searchValue As String, insertValue As String, C1 As Range, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
searchValue = Application.InputBox("Please supply search value", Type:=2)
insertValue = Application.InputBox("Please supply insert value", Type:=2)
If searchValue = vbNullString Or insertValue = vbNullString Then Exit Sub 'or loop prompting for entry
With ws
Set C1 = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Find(searchValue)
End With
If Not C1 Is Nothing Then C1.Offset(0, -1).Value = insertValue
End Sub

编辑:

从你的评论来看,你实际上只是在做一个VLOOKUP。

在表2A1中,填写以下内容,并自动填充B列中填充的行数。

=IFERROR(VLOOKUP(B1,Sheet1!A:B,2,FALSE),"")

使用数组和字典也是一样的

Option Explicit
Public Sub AddText()
Dim wsSource As Worksheet, wsSearch As Worksheet
Dim lookupArray(), updateArray(), lookupDict As Object, i As Long
Set lookupDict = CreateObject("Scripting.Dictionary")
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsSearch = ThisWorkbook.Worksheets("Sheet2")
With wsSource
lookupArray = .Range("A1:B" & GetLastRow(wsSource, 1)).Value
End With
For i = LBound(lookupArray, 1) To UBound(lookupArray, 1)
lookupDict(lookupArray(i, 1)) = lookupArray(i, 2)
Next
With wsSearch
updateArray = .Range("A1:B" & GetLastRow(wsSearch, 2)).Value
For i = LBound(updateArray, 1) To UBound(updateArray, 1)
If lookupDict.Exists(updateArray(i, 2)) Then
updateArray(i, 1) = lookupDict(updateArray(i, 2))
End If
Next
.Cells(1, 1).Resize(UBound(updateArray, 1), UBound(updateArray, 2)) = updateArray
End With
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
End With
End Function

最新更新