我有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
答案 0 :(得分:0)
尝试将范围读入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
答案 1 :(得分:0)
你可以试试这个
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