1

私は現在、「Email」または「Email-personalemail」という列を検索するVBAマクロの作成に取り組んでいます（これは同じ列ですが、これら2つの名前は代替です）。

したがって、最初に[電子メール]列を検索し、見つかったら、電子メールアドレスの最後にドットがあるかどうかを確認します。はいの場合、それらを削除する必要があります。

私はVBAの知識が限られており、ITの専門家ではありません。そのため、私は主にインターネットで見つけた既存のスクリプトを使用して修正します。以下は、2つのマクロを組み合わせて作成したコードです。これは正常に機能しますが、電子メール列が同じ場所（この場合は列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
4

1 に答える 1

0

以下が機能するはずです

'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
于 2013-02-07T10:20:25.320 に答える