。查找VBAmacros在一列中查找文本并向相邻列添加条件文本

只是想知道是否有人能比我更快，更清洁地解决这个问题。 另外，它看起来很麻烦，所以一个更stream畅的过程会有所帮助。 它似乎并不是一直工作，它的数据添加到其他列我没有打算。

我的问题是，我需要根据列O中提供的信息将数据input到列P中。列O具有标题“Job_Title”，而P是“Job_Function”。 有几个关键词我用这样做，你会看到在代码中。 有没有更好的守卫循环？ 有更好的循环？ 是否有更整洁，更快的代码，不会添加额外的数据到其他列？

感谢您提供的任何帮助。 另外，请参阅图像以参考添加到其他列的额外数据。

Sub Enter_Job_Function() Dim i As Integer Dim count1 As Integer Dim count2 As Integer ' the counters are for the message box to let me know how many items were added/modified i = 2 Do Until i = 300 On Error Resume Next Cells(i, 16).Find(What:="Architect").Offset(0, 1) = "Architect" Cells(i, 16).Find(What:="Manager").Offset(0, 1) = "Manager" Cells(i, 16).Find(What:="Mgr").Offset(0, 1) = "Manager" Cells(i, 16).Find(What:="Director").Offset(0, 1) = "Director" Cells(i, 16).Find(What:="Dir").Offset(0, 1) = "Director" Cells(i, 16).Find(What:="Dir,").Offset(0, 1) = "Director" Cells(i, 16).Find(What:="Chief").Offset(0, 1) = "Executive" Cells(i, 16).Find(What:="CIO").Offset(0, 1) = "Executive" Cells(i, 16).Find(What:="CTO").Offset(0, 1) = "Executive" Cells(i, 16).Find(What:="CEO").Offset(0, 1) = "Executive" Cells(i, 16).Find(What:="Vice President").Offset(0, 1) = "VP" Cells(i, 16).Find(What:="VP").Offset(0, 1) = "VP" i = i + 1 On Error GoTo 0 Loop Dim j As Integer ' This loop is for a separate column, this is also malfunctioning in a major way so any advise would be much appreciated. j = 1 Do Until j = 20 j = j + 1 Cells(j, 16).Find(What:="Technology").Offset(0, 2) = "Information Technology" Loop PromptDialog.Hide MsgBox i & " item(s) modified out of a possible " & i & " item(s)" ' I know this is not going to work as is, again, any advise would be awesome... End Sub 

Answer 1

我可能会使用主循环的字典项目。 它增加了一些可读性的代码。

 Sub Enter_Job_Function() Dim JobDictionary As Object Set JobDictionary = CreateObject("Scripting.Dictionary") JobDictionary.Add "Architect", "Architect" JobDictionary.Add "Manager", "Manager" JobDictionary.Add "Mgr", "Manager" JobDictionary.Add "Director", "Director" JobDictionary.Add "Dir", "Director" JobDictionary.Add "Dir,", "Director" JobDictionary.Add "Chief", "Executive" JobDictionary.Add "CIO", "Executive" JobDictionary.Add "CTO", "Executive" JobDictionary.Add "CEO", "Executive" JobDictionary.Add "Vice President", "VP" JobDictionary.Add "VP", "VP" Dim Modified As Integer For i = 2 To 300 If JobDictionary.Exists(Cells(i, 16).Value) Then Cells(i, 17).Value = JobDictionary.Item(Cells(i, 16).Value) Modified = Modified + 1 End If j = j + 1 Next i For i = 1 To 20 If Cells(i, 16).Value = "Technology" Then Cells(i, 18) = "Information Technology" Modified = Modified + 1 End If j = j + 1 Next i MsgBox Modified & " item(s) modified out of a possible " & j & " item(s)" End Sub 

更新：考虑到子stringsearch（删除“Dir”，因为“Dir”也将覆盖这些）

 Sub Enter_Job_Function() Dim JobDictionary As Object Set JobDictionary = CreateObject("Scripting.Dictionary") JobDictionary.Add "Architect", "Architect" JobDictionary.Add "Manager", "Manager" JobDictionary.Add "Mgr", "Manager" JobDictionary.Add "Director", "Director" JobDictionary.Add "Dir", "Director" JobDictionary.Add "Chief", "Executive" JobDictionary.Add "CIO", "Executive" JobDictionary.Add "CTO", "Executive" JobDictionary.Add "CEO", "Executive" JobDictionary.Add "Vice President", "VP" JobDictionary.Add "VP", "VP" Dim Modified As Integer For i = 2 To 300 For Each Item In JobDictionary.Keys If InStr(Cells(i, 16).Value, Item) Then Cells(i, 17).Value = JobDictionary.Item(Item) Modified = Modified + 1 End If Next j = j + 1 Next For i = 1 To 20 If InStr(Cells(i, 16).Value, "Technology") Then Cells(i, 18) = "Information Technology" Modified = Modified + 1 End If j = j + 1 Next MsgBox Modified & " item(s) modified out of a possible " & j & " item(s)" End Sub 

Answer 2

怎么样这样（试图坚持你的风格）：

 Sub Enter_Job_Function() Dim i As Integer Dim TotalItems As Integer Dim StartRow As Integer Dim EndRow As Integer Dim NotModified As Integer Dim Modified As Integer StartRow = 2 EndRow = 300 TotalItems = EndRow - StartRow + 1 For i = StartRow To EndRow If Cells(i, 16).Value = "Architect" Then Cells(i, 17).Value = "Architect" ElseIf Cells(i, 16).Value = "Manager" Then Cells(i, 17).Value = "Manager" ElseIf Cells(i, 16).Value = "Mgr" Then Cells(i, 17).Value = "Manager" ' 'other conditions here ' Else: NotModified = NotModified + 1 'count how many weren't modified (easier to do it this way) End If Next i 'do a similar thing for other column here Modified = TotalItems - NotModified 'work out how many we have modifed MsgBox ("Modified " & Modified & " out of a possible " & TotalItems) End Sub