여러 행의 Excel VBA 코드

Question

HTML 태그를 추가 할 때 VBA가 있습니다. 나는 J2 같은 여러 행에 대한 그 코드가 작동합니다 :

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 1

그 통해 반복 다음 VBA 배열로 범위를 읽는 시도하고 같은 J50000

코드입니다 이것을 시도하십시오

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 

Answer 2

당신이 할 수있는을 :

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