求助，如何用VBA根据A列毕业院校及专业拆分出毕业院校到B列，专业到C列

qinhuan66

求助，如何用VBA根据A列毕业院校及专业拆分出毕业院校到B列，专业到C列。谢谢

求助.rar (14.48 KB, 下载次数: 6)

2019-6-19 12:23 上传

点击文件名下载附件

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, mark, t
  arr = [a1].CurrentRegion
  mark = Split("学院 大学 党校 学校")
  For i = 2 To UBound(arr, 1)
    For j = 0 To UBound(mark)
      If InStr(arr(i, 1), mark(j)) Then
        t = Split(arr(i, 1), mark(j))
        arr(i, 2) = t(0) & mark(j)
        arr(i, 3) = t(1)
        Exit For
      End If
    Next
    If j = UBound(mark) + 1 Then arr(i, 2) = "?": arr(i, 3) = "??"
  Next
  [a1].CurrentRegion = arr
End Sub

dddfr

Sub 按钮1_Click()

Set RegExp = CreateObject("vbscript.regexp")
With RegExp
Set r = ActiveSheet.[A2]
While r <> ""
   .Pattern = "^.*(学校|大学|学院|党校|(港&^港口))"
    .Global = False
    Set o = .Execute(r.Text)
    For Each result In o
        r.Offset(0, 1) = result
        r.Offset(0, 2) = Replace(r.Text, result, "")
    Next
   
Set r = r.Offset(1, 0)
Wend
End With


End Sub

wdx223

1. Sub 按钮1_Click()
   
2. Dim data, i&, ms
   
3. data = ThisWorkbook.Worksheets("求助").[A1].CurrentRegion.Value
   
4. 
   
5. With CreateObject("VBScript.RegExp")
   
6.     .Global = True
   
7.     .Pattern = "(\S+(?:大学|学校|学院|高中|党校))(\S*)"
   
8.     For i = 2 To UBound(data)
   
9.         Set ms = .Execute(data(i, 1))
   
10.         data(i, 2) = ms(0).submatches(0)
    
11.         data(i, 3) = ms(0).submatches(1)
    
12.     Next i
    
13. End With
    
14. ThisWorkbook.Worksheets("求助").[A1].Resize(UBound(data), UBound(data, 2)) = data
    
15. End Sub

复制代码