提取和b列相同的英文字串

cmo9020

请问导师，要从a列提取和G列相同的英文字符串，到B列要怎么写？因为a列最长11码
TEST.rar (11.06 KB, 下载次数: 13)

2022-12-29 17:48 上传

点击文件名下载附件

LIUZHU

请上传附件，这种问题，一般用循环或者正则表达式处理即可

ykcbf1100

没有附件，大致就这个样子吧。

tmplinshi

1. Sub 提取关键词()
   
2. 
   
3.     Dim arrA(), arrB(), arrC(), str$, key$, r%
   
4.    
   
5.     arrA = ArrayFromColumn("A")
   
6.     arrB = ArrayFromColumn("B")
   
7.     arrC = CloneSize(arrA)
   
8. 
   
9.     For r = 1 To UBound(arrA)
   
10.         str = arrA(r, 1)
    
11.         key = FindKeyword(str, arrB)
    
12.         arrC(r, 1) = key
    
13.     Next
    
14.    
    
15.     [C:C].ClearContents
    
16.     CellWriteArray [C1], arrC
    
17. 
    
18. End Sub
    
19. 
    
20. Function FindKeyword(str, keys()) As String
    
21.     Dim k
    
22.    
    
23.     For Each k In keys
    
24.         If InStr(1, str, k) > 0 Then
    
25.             FindKeyword = k
    
26.             Exit Function
    
27.         End If
    
28.     Next
    
29. End Function
    
30. 
    
31. Function ArrayFromColumn(col)
    
32.     Dim endRow As Long
    
33.     endRow = Cells(1, col).End(xlDown).Row
    
34.     ArrayFromColumn = Cells(1, col).Resize(endRow).Value2
    
35. End Function
    
36. 
    
37. Function CloneSize(arr())
    
38.     ReDim out(LBound(arr) To UBound(arr), LBound(arr, 2) To UBound(arr, 2))
    
39.     CloneSize = out
    
40. End Function
    
41. 
    
42. Sub CellWriteArray(cell As Range, arr())
    
43.     cell.Resize(UBound(arr), UBound(arr, 2)).Value2 = arr
    
44. End Sub
    

复制代码

cmo9020

ykcbf1100 发表于 2022-12-29 15:25
没有附件，大致就这个样子吧。

谢谢导师帮忙,不过有显示数组超出范围问题,,,,,


Sub ykebf()
Dim arr, b
r = Cells(Rows.Count, "a").End(xlUp).Row
arr = Range("a1", Cells(r, "c"))
b = [g2:g7]
For i = 1 To UBound(arr)
s = arr(i, 1)
For j = 0 To UBound(b)
If InStr(s, b(j)) Then
arr(i, 3) = b(j)
End If
Next
Next
Range("a1", Cells(r, "c")) = arr
End Sub

cmo9020

LIUZHU 发表于 2022-12-29 15:15
请上传附件，这种问题，一般用循环或者正则表达式处理即可

临时用函数mid.ligh去捉...捉的不是很准确
附件以上传,在请导师看一下,谢谢导师

shiruiqiang

cmo9020 发表于 2022-12-29 17:56
临时用函数mid.ligh去捉...捉的不是很准确
附件以上传,在请导师看一下,谢谢导师

就是同时有大小写字母怎么处理？还有“xp”和“xpr”以后面为准吗？

dambcer

pq处理                              

gwjkkkkk

请楼主参考附件。。。

cmo9020

gwjkkkkk 发表于 2022-12-29 19:11
请楼主参考附件。。。

谢谢导师帮忙~