Question

我需要一个小项目的帮助。我刚开始使用VBA，我想我可以使用学习来优化我的代码。

单元格A2，包含一个文本，其中包含许多以＆＃34;，＆＃34;分隔的电子邮件地址。我设法提取所有的电子邮件地址，但我认为我过多地使用了单元格，我想知道你是否可以帮助我减少它并使用定义的变量。 Screenshot of the working code

 Sub fpor()
Dim Text As String
Dim full As Integer
Dim i As Integer
Dim e As Integer
Dim part As String
Dim part_len As Integer
Dim part_a As Integer
Dim Text_2 As String
x = 5

        ActiveCell = Range("A2")
        Text = Range("A2")
        full = Len(Text)
        'full = InStrRev(Text, ",")

                 For i = 1 To full

                        Cells((x + i), 1).Value = Text
                        part = InStr(Text, ",")
                        Cells((x + i), 2).Value = part
                        Cells((x + i), 3) = Left(Text, part)
                        Cells((x + i), 4) = full - part
                        Text = Right(Cells((x + i), 1), Cells((x + i), 4))

                            If part = 0 Then
                                full = 0
                                Cells((x + i), 3) = Text
                                Exit For
                            Else:
                                full = Len(Text)
                            End If

                    Next i

       MsgBox (full)
       MsgBox (part)

     End Sub `

您认为我如何更好地优化For Loop？

谢谢你们所有人的答案：）

Answer 1

您可以使用Split()函数大大简化您的代码，如下所示：

Option Explicit

Sub fpor()
    Dim emailsArr As Variant

    With Worksheets("emails") '<--change "emails" with your actual sheet name
        emailsArr = Split(.Range("a2"), ",") '<--| split all emails names delimited by a ',' into an array
        .Range("A6").Resize(UBound(emailsArr)).value = Application.Transpose(emailsArr) '<--| write array content from cell A6 downwards
    End With
End Sub

VBA文本循环优化 - 从文本中提取电子邮件

1 个答案: