多行的Excel VBA代码 [英] Excel VBA Code for Multiple Rows

问题描述

我有用于附加HTML标记的VBA.我希望该代码适用于多个行，例如J2:J50000

I have got VBA for Appending HTML Tag. I want that code work for multiple Rows like J2:J50000

代码就像

Option Explicit

Sub main()
    Dim newStrng As String
    Dim word As Variant
    Dim parTag As String, endParTag As String
    Dim dateCounter As Long

    parTag = "<p>" '
    endParTag = "</p>" '
    With Worksheets("TextSheet") '
        For Each word In Split(.Range("A1").Text, " ") '<-- Range should be like A1:A50000
            If Len(word) - Len(Replace(word, "/", "")) = 2 Then
                dateCounter = dateCounter + 1
                If dateCounter > 1 Then newStrng = newStrng & endParTag
                newStrng = newStrng & parTag & word
            Else
                newStrng = newStrng & " " & word
            End If
        Next word
        If dateCounter > 1 Then newStrng = newStrng & endParTag
        .Range("A2").Value = LTrim(newStrng)
    End With
End Sub

推荐答案

您可以尝试

Option Explicit

Sub main2()
    Dim newStrng As String
    Dim word As Variant
    Dim usedCell As Variant
    Dim dataArr As Variant
    Dim parTag As String, endParTag As String
    Dim dateCounter As Long
    Dim i As Long

    parTag = "<p>" '
    endParTag = "</p>" '
    With Worksheets("TextSheet") '
        dataArr = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value
        For i = 1 To UBound(dataArr, 1)
            dateCounter = 0
            newStrng = ""
            For Each word In Split(dataArr(i, 1), " ")
                If Len(word) - Len(Replace(word, "/", "")) = 2 Then
                    dateCounter = dateCounter + 1
                    If dateCounter > 1 Then newStrng = newStrng & endParTag
                    newStrng = newStrng & parTag & word
                Else
                    newStrng = newStrng & " " & word
                End If
            Next word
            If dateCounter > 1 Then newStrng = newStrng & endParTag
            dataArr(i, 1) = LTrim(newStrng)
        Next i
        .Range("B1").Resize(UBound(dataArr, 1)).Value = dataArr
    End With
End Sub

这篇关于多行的Excel VBA代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！