求VBA代码实现，提取结果列数据

倾听冷暖丿

各位老师，需要从A列提取B列的数据，用VBA怎么实现呢？谢谢

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, Matches As Object
   
    ar = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    ar(1, 1) = "结果"
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = ".+?([A-Z]+)"
        For i = 2 To UBound(ar)
            If .test(ar(i, 1)) Then
                Set Matches = .Execute(ar(i, 1))
                ar(i, 1) = Matches(Matches.Count - 1).submatches(0)
            Else
                ar(i, 1) = Empty
            End If
        Next i
    End With
   
    Columns("B").Clear
    [B1].Resize(UBound(ar)) = ar
    Beep
End Sub

gwjkkkkk

请参考附件。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf() '//2024.1.16
   
2.     Set reg = CreateObject("VBScript.RegExp")
   
3.     With Sheets("Sheet1")
   
4.         r = Cells(Rows.Count, 1).End(3).Row
   
5.         arr = Range("a1:b" & r)
   
6.         For i = 2 To UBound(arr)
   
7.             s = arr(i, 1)
   
8.             With reg
   
9.                 .Pattern = "[A-Z]+$"
   
10.             End With
    
11.             Set mh = reg.Execute(s)
    
12.             If mh.Count > 0 Then
    
13.                 arr(i, 2) = mh(0).Value
    
14.             Else
    
15.                 arr(i, 2) = ""
    
16.             End If
    
17.         Next
    
18.         Range("a1:b" & r) = arr
    
19.     End With
    
20. End Sub
    
21. 
    

复制代码

ykcbf1100

用正则提取比较简单。

高个子

抄一个，香川正则函数刚好用上

yynrzwh

网站不太正常？

yynrzwh

1. Sub test()
   
2. 
   
3. Sheet1.UsedRange.Offset(1, 1) = ""
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         s = arr(i, 1)
   
7.         For x = Len(s) To 1 Step -1
   
8.             cod = VBA.Asc(Mid(s, x, 1))
   
9.             If cod < 65 Or cod > 90 Then
   
10.                 Exit For
    
11.             End If
    
12.         Next x
    
13.         arr(i, 2) = Mid(s, x + 1)
    
14.     Next i
    
15. Sheet1.Range("a1").CurrentRegion = arr
    
16. End Sub

复制代码

cztanghao

import re,openpyxl
wb=openpyxl.load_workbook('./求VBA代码实现，提取结果列数据.xlsx')
ws=wb.active
pattern=re.compile(r'[A-Z]{4,}')
for c in list(ws['a'])[1:]:
    # print(i.value)
    m=pattern.search(c.value)
    print(m.group(0))
    c.offset(0,2).value=m.group(0)
wb.save('./pythonCode.xlsx')

倾听冷暖丿

gwjkkkkk 发表于 2024-1-16 18:17
Option Explicit
Sub TEST1()
    Dim ar, i&, Matches As Object

非常感谢老师