Код Excel VBA для нескольких строк

Question

У меня есть VBA для добавления HTML-тегов. Я хочу, чтобы код работает для нескольких строк, как 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 

Answer 1

Попробуйте прочитать диапазон в массив Vba, а затем циклически, что:

Sub main() 
    Dim newStrng As String 
    Dim word As Variant 
    Dim usedCell As Variant 
    Dim inputArray() As Variant 
    Dim outputArray() As Variant 
    Dim parTag As String, endParTag As String 
    Dim dateCounter As Long 
    Dim i As Long 

    parTag = "<p>" ' 
    endParTag = "</p>" ' 
    With Worksheets("TextSheet") ' 
     inputArray = .Range("A1:A50000").Value 
     ReDim outputArray(1 To UBound(inputArray, 1)) 
     For i = 1 To UBound(inputArray, 1) 
      dateCounter = 0 
      newStrng = "" 
      For Each word In Split(inputArray(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 
      outputArray(i) = LTrim(newStrng) 
     Next i 
     .Range("B1:B50000").Value = Application.Transpose(outputArray) 
    End With 
End Sub 

Answer 2

вы можете попробуйте это

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