ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 Office 365免费试用,报名现在开始! 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 打造核心竞争力的职场宝典 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 77|回复: 1

[求助] 请在师修改下代码,谢谢!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-7-13 10:27 | 显示全部楼层 |阅读模式
本帖最后由 冷酷的云 于 2018-7-13 10:34 编辑

Sub text()
    Dim arr, i%, wb As Workbook, rng As Range
    Set wb = GetObject(ThisWorkbook.Path & "\冻干.xls")
    arr = wb.Sheets(1).Range("A1").CurrentRegion
    With wb.Sheets(1)
    For i = 1 To UBound(arr)
        If InStr(arr(i, 6), [O3].Value) Then                                                   
        If InStr(arr(i, 8), [p3].Value) Then
        If InStr(arr(i, 10), [q3].Value) Then
        If InStr(arr(i, 12), [r3].Value) Then
            If rng Is Nothing Then
                Set rng = .Range(.Cells(i, 1), .Cells(i, 12))
            Else
                Set rng = Union(rng, .Range(.Cells(i, 1), .Cells(i, 12)))
            End If
         End If
         End If
         End If
         End If
    Next
    If Not rng Is Nothing Then rng.Copy Range("A2")
    End With
    wb.Close False

End Sub
请教大师:把条件同时为真时,修改为只要符合任意一个条件为真时,全部提取过来谢谢!


TA的精华主题

TA的得分主题

发表于 2018-7-13 13:28 | 显示全部楼层
Sub test()
    Dim arr, i%, wb As Workbook, rng As Range, Brr()
    Set wb = GetObject(ThisWorkbook.Path & "\冻干.xls")
    arr = wb.Sheets(1).Range("A1").CurrentRegion
    Brr = Range("o3:r3").Value
    With wb.Sheets(1)
        For i = 1 To UBound(arr)
            For j = 1 To 4
                If arr(i, j * 2 + 4) Like "*" & Brr(1, j) & "*" Then Exit For
            Next
            If j <= 4 Then
                If rng Is Nothing Then
                    Set rng = .Range(.Cells(i, 1), .Cells(i, 12))
                Else
                    Set rng = Union(rng, .Range(.Cells(i, 1), .Cells(i, 12)))
                End If
            End If
        Next
        If Not rng Is Nothing Then rng.Copy Range("A2")
    End With
    wb.Close False

End Sub

评分

参与人数 1鲜花 +2 收起 理由
冷酷的云 + 2 值得肯定

查看全部评分

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

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2018-8-18 12:35 , Processed in 0.062066 second(s), 14 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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