Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/17.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
在VBA中扫描Excel列以查找特定单词_Vba_Excel - Fatal编程技术网

在VBA中扫描Excel列以查找特定单词

在VBA中扫描Excel列以查找特定单词,vba,excel,Vba,Excel,目前,我正在处理数据库Excel电子表格,我正在使用VBA实现系统的一些自动功能。我是VBA新手,所以我需要你的帮助:) 我的问题是:我有一个状态栏,用户需要从下拉列表中选择“完成”或“进行中”。我需要一个程序,可以扫描一个特定的列(例如S3)的单词“完成”。一旦检测到该单词,系统将自动向特定用户发送电子邮件,告诉他任务已完成 有人能帮我吗 谢谢!:) 更新:我编写了以下代码来搜索单词complete并向用户发送电子邮件(这是一个粗略的想法) Sub-Send_Email_使用_VBA() D

目前,我正在处理数据库Excel电子表格,我正在使用VBA实现系统的一些自动功能。我是VBA新手,所以我需要你的帮助:)

我的问题是:我有一个状态栏,用户需要从下拉列表中选择“完成”或“进行中”。我需要一个程序,可以扫描一个特定的列(例如S3)的单词“完成”。一旦检测到该单词,系统将自动向特定用户发送电子邮件,告诉他任务已完成

有人能帮我吗

谢谢!:)

更新:我编写了以下代码来搜索单词complete并向用户发送电子邮件(这是一个粗略的想法)

Sub-Send_Email_使用_VBA()
Dim Email_主题、Email_Send_From、Email_Send_To、_
电子邮件抄送、电子邮件密件抄送、电子邮件正文为字符串
Dim Mail_对象,Mail_单个作为变量
电子邮件\u Subject=“测试结果”
电子邮件\u发送\u发件人=”fromperson@example.com"
电子邮件发送至“toperson@example.com"
'Email_Cc='someone@example.com"
'电子邮件_Bcc='someoneelse@example.com"
Email\u Body=“恭喜!!!!您已成功使用VBA发送电子邮件!!!!”
关于错误转到调试
设置Mail\u Object=CreateObject(“Outlook.Application”)
设置Mail\u Single=Mail\u Object.CreateItem(0)
单程邮寄
.Subject=电子邮件主题
.To=发送电子邮件至
.cc=电子邮件\u cc
.BCC=电子邮件\u BCC
.Body=电子邮件\正文
.发送
以
调试:
如果错误描述为“”,则MsgBox错误描述为“”
端接头

试试这个(试过并测试过)

屏幕截图

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long, lRow As Long
    Dim ExitLoop As Boolean
    Dim aCell As Range, bCell As Range

    '~~> Set this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find the word in the relevant column. 19 is S Column
        Set aCell = .Columns(19).Find(What:="Complete", LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            '~~> Update Col T appropriately
            '~~> This is required so that mail doesn't go for the same row again
            '~~> When you run the macro again

            Set bCell = aCell

            If Not .Range("T" & aCell.Row).Value = "Mail Sent" Then
                If SendEmail = True Then
                    .Range("T" & aCell.Row).Value = "Mail Sent"
                Else
                    .Range("T" & aCell.Row).Value = "Error: Mail Not Sent"
                End If
            End If

            Do While ExitLoop = False
               Set aCell = .Columns(19).FindNext(After:=aCell)

               If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do

                    If Not .Range("T" & aCell.Row).Value = "Mail Sent" Then
                        If SendEmail = True Then
                            .Range("T" & aCell.Row).Value = "Mail Sent"
                        Else
                            .Range("T" & aCell.Row).Value = "Error: Mail Not Sent"
                        End If
                    End If
               Else
                   ExitLoop = True
               End If
            Loop
        End If
    End With
End Sub

Function SendEmail() As Boolean
    Dim OutApp As Object, OutMail As Object

    On Error GoTo Whoa

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "toperson@example.com"
        .Subject = "Testing Results"
        .Body = "Your Message Goes Here"
        .Display
    End With

    DoEvents

    SendEmail = True

LetsContinue:
    On Error Resume Next
    Set OutMail = Nothing
    Set OutApp = Nothing
    On Error GoTo 0

    Exit Function
Whoa:
    SendEmail = False
    Resume LetsContinue
End Function


你的问题很广泛-你能更具体地解释一下你的困境吗?我困在VBA程序中。我不知道从何处开始我需要扫描excel电子表格中的一列,以查找“完成”一词,一旦找到该词,将发送电子邮件。该列是否只需要包含“完成”一次,即可发送电子邮件,或者宏是否应该检查每一行,并在每一行第一次出现complete一词时发送电子邮件?是的,每次找到complete一词时都需要发送电子邮件。非常感谢代码!非常优雅的解决方案。我已经对代码进行了一次试运行,在第一次运行代码后,这行代码中出现了一个错误91:如果不是aCell,那么如果aCell.Address=bCell.Address,那么退出DoDid。您是否更改了代码中的任何内容?我可以看一个示例文件以便测试上述代码吗?如果是,那么你可以在www.wikisend.com上传文件并在这里共享链接。不,我没有更改上述代码。我上传了这个链接上的文件:非常感谢!最后一个问题…有没有办法实时运行宏?示例:如果excel文件已经打开,并且用户更改了状态,宏是否可以在更改完成后立即发送电子邮件?再次感谢:)是的。有关如何使用
工作表\u更改
事件,请参阅此链接。
Sub Send_Email_Using_VBA()

    Dim Email_Subject, Email_Send_From, Email_Send_To, _
    Email_Cc, Email_Bcc, Email_Body As String
    Dim Mail_Object, Mail_Single As Variant
    Email_Subject = "Testing Results"
    Email_Send_From = "fromperson@example.com"
    Email_Send_To = "toperson@example.com"
    'Email_Cc = "someone@example.com"
    'Email_Bcc = "someoneelse@example.com"
    Email_Body = "Congratulations!!!! You have successfully sent an e-mail using VBA !!!!"
    On Error GoTo debugs
    Set Mail_Object = CreateObject("Outlook.Application")
    Set Mail_Single = Mail_Object.CreateItem(0)
    With Mail_Single
    .Subject = Email_Subject
    .To = Email_Send_To
    .cc = Email_Cc
    .BCC = Email_Bcc
    .Body = Email_Body
    .send
    End With
    debugs:
    If Err.Description <> "" Then MsgBox Err.Description
End Sub
Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long, lRow As Long
    Dim ExitLoop As Boolean
    Dim aCell As Range, bCell As Range

    '~~> Set this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find the word in the relevant column. 19 is S Column
        Set aCell = .Columns(19).Find(What:="Complete", LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            '~~> Update Col T appropriately
            '~~> This is required so that mail doesn't go for the same row again
            '~~> When you run the macro again

            Set bCell = aCell

            If Not .Range("T" & aCell.Row).Value = "Mail Sent" Then
                If SendEmail = True Then
                    .Range("T" & aCell.Row).Value = "Mail Sent"
                Else
                    .Range("T" & aCell.Row).Value = "Error: Mail Not Sent"
                End If
            End If

            Do While ExitLoop = False
               Set aCell = .Columns(19).FindNext(After:=aCell)

               If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do

                    If Not .Range("T" & aCell.Row).Value = "Mail Sent" Then
                        If SendEmail = True Then
                            .Range("T" & aCell.Row).Value = "Mail Sent"
                        Else
                            .Range("T" & aCell.Row).Value = "Error: Mail Not Sent"
                        End If
                    End If
               Else
                   ExitLoop = True
               End If
            Loop
        End If
    End With
End Sub

Function SendEmail() As Boolean
    Dim OutApp As Object, OutMail As Object

    On Error GoTo Whoa

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "toperson@example.com"
        .Subject = "Testing Results"
        .Body = "Your Message Goes Here"
        .Display
    End With

    DoEvents

    SendEmail = True

LetsContinue:
    On Error Resume Next
    Set OutMail = Nothing
    Set OutApp = Nothing
    On Error GoTo 0

    Exit Function
Whoa:
    SendEmail = False
    Resume LetsContinue
End Function