范围=在之前find的列

我目前正在创build一个VBAmacros,它将search名为“电子邮件”或“电子邮件 – 个人电子邮件”(这是同一列,但这两个名称是替代品)列。

因此,首先search电子邮件列,然后find,然后检查电子邮件地址末尾是否有任何点。 如果是的话,应该删除它们。

我有限的VBA知识,我不是IT preson。 所以我主要使用和修改我在互联网上find的现有脚本。 下面是我结合2个macros的代码。 它工作正常,但只有当电子邮件列在相同的地方(在这种情况下列S)。 我应该如何修改代码才能使用电子邮件标题被发现的列?

我的代码:

Sub GOOD_WORKS_No_Dots_at_End_of_Emails() Dim strSearch As String Dim aCell As Range strSearch = "Email*" Set aCell = Sheet2.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then Sheets("Data").Activate Dim LR As Long, i As Long LR = Range("S" & Rows.Count).End(xlUp).Row For i = 1 To LR With Range("S" & i) If Right(.Value, 1) = "." Then .Value = Left(.Value, Len(.Value) - 1) End With Next i Sheets("Automation").Activate MsgBox "No Dots at the end of email addresses - Done!" End If End Sub 

以下应该工作

 'rowNum<~~~ Enter the row number your "Header fields" are in 'returns a dictionary object Function getAllColNum(ByVal rowNum As Long, ByVal searchString As Variant) As Object Dim allColNum As Object Dim i As Long Dim j As Long Dim width As Long Set allColNum = CreateObject("Scripting.Dictionary") colNum = 1 With ActiveSheet width = .Cells(rowNum, .Columns.Count).End(xlToLeft).Column For i = 1 To width If InStr(UCase(Trim(.Cells(rowNum, i).Value)), UCase(Trim(searchString))) > 0 Then allColNum.Add i, "" End If ' Next i End With Set getAllColNum = allColNum End Function Sub GOOD_WORKS_No_Dots_at_End_of_Emails() Dim strSearch As String strSearch = "Email" Dim colNum As Variant Dim allColNum As Object Sheets("Data").Activate Dim LR As Long, i As Long Set allColNum = getAllColNum(1, searchString) For Each colNum In allColNum LR = Cells(Rows.Count, colNum).End(xlUp).Row For i = 1 To LR With Range(Cells(i, colNum), Cells(i, colNum)) If Right(.Value, 1) = "." Then .Value = Left(.Value, Len(.Value) - 1) End With Next i Next colNum Sheets("Automation").Activate MsgBox "No Dots at the end of email addresses - Done!" End Sub