Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 3484|回复: 13

[已解决]请教如果用VBA提取品牌

[复制链接]
发表于 2013-11-15 16:53 | 显示全部楼层 |阅读模式
本帖最后由 chensir 于 2013-11-15 17:04 编辑

请教各位,用vba把表内D列的品牌提取到C列,如何操作,谢谢
最佳答案
2013-11-15 17:17
Sub test1()
    Dim r, i
    r = Range("d65536").End(xlUp).Row
    For i = 2 To r
        Cells(i, 3) = f(Cells(i, 4))
    Next i
End Sub
Function f(str)
    Dim regex As Object, matchs As Object
    Dim i As Integer
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Global = False
        .Pattern = "[A-Za-z]+\w+"   
        Set matchs = .Execute(str)
        If .test(str) Then
        Set matchs = .Execute(str)
            f = matchs(0)
        End If
    End With
End Function

品牌是不是:店名中第一个以字母打头,由字母和数字组成的字符串?

工作簿1.rar

6.11 KB, 下载次数: 27

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2013-11-15 16:57 | 显示全部楼层
"这个要注意变成PM",这是什么意思呀?
回复

使用道具 举报

 楼主| 发表于 2013-11-15 17:02 | 显示全部楼层
爱疯 发表于 2013-11-15 16:57
"这个要注意变成PM",这是什么意思呀?

不用管这个删掉就好了,我重新换一下附件,谢谢
回复

使用道具 举报

发表于 2013-11-15 17:17 | 显示全部楼层    本楼为最佳答案   
Sub test1()
    Dim r, i
    r = Range("d65536").End(xlUp).Row
    For i = 2 To r
        Cells(i, 3) = f(Cells(i, 4))
    Next i
End Sub
Function f(str)
    Dim regex As Object, matchs As Object
    Dim i As Integer
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Global = False
        .Pattern = "[A-Za-z]+\w+"   
        Set matchs = .Execute(str)
        If .test(str) Then
        Set matchs = .Execute(str)
            f = matchs(0)
        End If
    End With
End Function

品牌是不是:店名中第一个以字母打头,由字母和数字组成的字符串?

回复

使用道具 举报

 楼主| 发表于 2013-11-15 17:21 | 显示全部楼层
爱疯 发表于 2013-11-15 17:17
Sub test1()
    Dim r, i
    r = Range("d65536").End(xlUp).Row

品牌是以英文字母或英文字母和数字的组合,品牌第一个字母是英文
回复

使用道具 举报

发表于 2013-11-15 17:22 | 显示全部楼层
  1. Sub t()
  2. Dim match, matches, arr(), brr(), i As Integer
  3. arr = Range("D2:D" & Cells(Rows.Count, 4).End(3).Row).Value
  4. ReDim brr(1 To UBound(arr), 1 To 1)
  5. For i = 1 To UBound(arr)
  6.   With CreateObject("vbscript.regexp")
  7.    .Pattern = "[0-Z].*?"
  8.    .Global = True
  9.    Set matches = .Execute(arr(i, 1))
  10.    For Each match In matches
  11.      brr(i, 1) = brr(i, 1) & match
  12.    Next
  13.   End With
  14. Next
  15. Range("C2").Resize(UBound(brr)) = brr
  16. End Sub
复制代码

评分

参与人数 2 +39 收起 理由
chensir + 18 赞一个!
CheryBTL + 21 正则很给力!

查看全部评分

回复

使用道具 举报

发表于 2013-11-15 17:25 | 显示全部楼层
请测试、

提取品牌.zip

12.58 KB, 下载次数: 4

评分

参与人数 1 +18 收起 理由
chensir + 18 赞一个!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2013-11-15 17:38 | 显示全部楼层
爱疯 发表于 2013-11-15 17:17
Sub test1()
    Dim r, i
    r = Range("d65536").End(xlUp).Row

如果把品牌提取出来后,C列为空的时候取B列数据,怎么弄啊,谢谢
回复

使用道具 举报

 楼主| 发表于 2013-11-15 17:45 | 显示全部楼层
yyyydddd8888 发表于 2013-11-15 17:25
请测试、

如果把品牌提取出来后,C列为空的时候取B列数据,怎么弄啊,谢谢
回复

使用道具 举报

发表于 2013-11-15 17:50 | 显示全部楼层
chensir 发表于 2013-11-15 17:45
如果把品牌提取出来后,C列为空的时候取B列数据,怎么弄啊,谢谢

6楼代码,在12句后增加一句即可
  1.             If brr(i,1)= "" Then brr(i, 1) = ar(i, 1)
复制代码

评分

参与人数 1 +18 收起 理由
chensir + 18 谢谢

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 13:47 , Processed in 0.607376 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表