Question

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

我的问题是我需要根据列O中提供的信息将数据输入到列P中。列O的标题是＆＃34; Job_Title＆＃34;而P是＆＃34; Job_Function＆＃34;。我将使用一些关键词来执行此操作，您将在代码中看到。循环中是否有更好的Guard？有更好的循环??是否有更整洁，更快的代码，不会将额外的数据添加到其他列？

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

 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 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

Answer 2

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

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

更新：考虑子串搜索（删除“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

.find VBA Macro在一列中查找文本，并将条件文本添加到相邻列

2 个答案: