|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Sub TEST1()
Dim ar, br, i&, c&, r&, strLetter$
With Sheets("原始数据")
ar = Range(.[A4], .Cells(Rows.Count, "A").End(xlUp)).Value
End With
ReDim br(1 To UBound(ar), 1 To 7)
r = 1
With CreateObject("VBScript.RegExp")
.Pattern = "[A-Z]+$"
For i = 1 To UBound(ar)
If Len(ar(i, 1)) Then
If c = 1 Then c = 2
c = c + 1
br(r, c) = ar(i, 1)
If c = 1 Then
strLetter = .Execute(br(r, c))(0).Value
Else
If InStr(br(r, c), strLetter) Then br(r, 2) = br(r, c)
End If
Else
r = r + 2
c = 0
End If
Next i
End With
Cells.Clear
[A1].Resize(r, UBound(br, 2)) = br
Beep
End Sub
|
|