Excel精英培训网

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

麻烦老师帮我做个条件查找返回值的宏

[复制链接]
发表于 2019-6-24 16:58 | 显示全部楼层 |阅读模式
1学分
本帖最后由 zhxj1983 于 2019-6-28 09:12 编辑

这个表格主要都是像函数 VLOOKUP这样查找返回数值的,但是因为有太多的列是要这样处理的,所以用公式的话表格只要记录多了就会很卡。而且还有符合条件替换,或是直接组合的一些要求。麻烦老师们看看,能不能做个宏给我。

订单汇总表.rar

22.19 KB, 下载次数: 7

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2019-6-24 23:40 | 显示全部楼层
回复

使用道具 举报

发表于 2019-6-25 10:15 | 显示全部楼层
我下载看了下:
1、数据结构混乱,明显是稍微懂点函数喜欢瞎琢磨的人做的表,东一块西一块的数据,别人拿去看的头都大。你就不能把数据弄成一个整块的连续区域?“产品结构表”C列、L列、S列都是空白,我理解这三个区域是不同的数据块,通常要分成三个不同的表来存放数据会比较清晰;
2、你的要求太多而且不严谨,有自相矛盾的地方。要求多还可以理解,但第3条和第7条是矛盾的,我也不知道哪个对?
3、这句话不好实现:“I列至Q列单元格,如果在前一次就已经有生成信息了..要跳过这些行”,本来从用户的角度提要求没错,但你这要求我认为是瞎琢磨的结果。这么说可能不礼貌,真的,你需要好好组织下你的数据别人才好写代码;
4、总体上我觉得编程难度很低,就是一些简单要求的重复,但最后那一句话的代码却不好写。我提个建议:查询的数据有可能出于某种需要由人工修改,就像你所做的,先把自己需要的数据预先填在了 I-P 列的某些单元格,这些已经填好数据的单元格不再需要代码来查找了。OK没问题,代码做得了。代码不知道的是如何准确判断该找还是不该找?我无法判断是我代码生成的信息呢还是你先预填上去的。为了可重复统计,从代码的角度,所有的单元格都是可写入数据的,因为不排除“产品结构表”的源数据更新了呢?所以你需要准确地把规则写出来,我认为你现在说的规则很随意,只是笼统说一句有数据的不填,这个搞不了。
回复

使用道具 举报

发表于 2019-6-25 10:59 | 显示全部楼层
上面虽然我说了一堆你不是的话,我还是先给你写了个代码模板。结果对不对需要你来判断。另外,你最后那句“有数据不填”的话我忽略了。
代码要放在“网点订单汇总表里”,切记。
Range("i2:p" & [b10000].End(3).Row).ClearContents
Application.ScreenUpdating = False
Dim arr
arr = Worksheets("产品结构表").Range("a1:x" & Worksheets("产品结构表").[d10000].End(3).Row)
For i = 2 To [b10000].End(3).Row
    For k = 2 To UBound(arr)
        If Cells(i, 6) = arr(k, 13) Then
           Cells(i, "i") = arr(k, 14)
        End If
        If Cells(i, 4) = arr(k, 1) Then
           Cells(i, "j") = arr(k, 2)
        End If
        If Cells(i, 5) = arr(k, 4) Then
           Cells(i, "k") = arr(k, 5)
           Cells(i, "p") = arr(k, 6)
        End If
        If Cells(i, 4) = arr(k, 16) Then
           Cells(i, "l") = arr(k, 17)
           Cells(i, "m") = arr(k, 18)
        End If
   Next k
   If Not IsEmpty(Cells(i, "f")) Then
      Cells(i, "n") = Cells(i, "f") & Cells(i, "l")
   End If
   If Not IsEmpty(Cells(i, "i")) Then
      Cells(i, "o") = Cells(i, "i") & Cells(i, "m")
   End If
   If Not IsEmpty(Cells(i, "j")) Then
      Cells(i, "q") = Cells(i, "j") & Cells(i, "p")
   End If
Next i
Application.ScreenUpdating = True
回复

使用道具 举报

 楼主| 发表于 2019-6-25 16:14 | 显示全部楼层
本帖最后由 zhxj1983 于 2019-6-25 16:15 编辑
hfwufanhf2006 发表于 2019-6-25 10:59
上面虽然我说了一堆你不是的话,我还是先给你写了个代码模板。结果对不对需要你来判断。另外,你最后那句“ ...

老师说的是,主要是我们这里的东西都是乱七八糟的,我自己都有时说不太清楚,所以我讲的都是比较土的讲法,就只会说这一列的数据,要去哪里匹配过来。这条代码我看了,能处理掉我很多要求了。有两个小问题看老师有没有帮忙解决。
第一个是61行的,这里面的型号是10CM的大写,资料那边的是小写,有没有办法让代码直接把这两个等同呢?
第二个就是第5条要求的问题,老师看表1第二行那条记录,里面F列的花色是针织黄#07,所以N列的正面编码是这个针织黄#07120*200,我这里要做个替换,看产品结构表的H60-I62这里。就是说表1 F列的花色,如果是H60-H62里面的这三个花色的话,就对应替换成I列60-62的里面的叫法,然后才组合,所以N列的那个正面编码正确应该是浅金#05120*200
回复

使用道具 举报

发表于 2019-6-27 09:26 | 显示全部楼层
zhxj1983 发表于 2019-6-25 16:14
老师说的是,主要是我们这里的东西都是乱七八糟的,我自己都有时说不太清楚,所以我讲的都是比较土的讲法 ...

1、大小写转换可以做的,用ucase函数,你在代码里把所有的条件比较都加上这个函数,比如
    If Cells(i, 5) = arr(k, 4) Then  写改成 If ucase(Cells(i, 5)) = ucase(arr(k, 4)) Then
    上面只是对查询条件不区分大小写来进行比较,但返回的值仍然是原始的数据,如果你希望返回的值全部都是大写,那还需要把写入数据的代码也全部改一遍,比如:
    Cells(i, "k") = arr(k, 5) 改成 Cells(i, "k") = ucase(arr(k, 5))
2、你第二个问题我没看懂,我昨天没上论坛,今天再看记忆就有点模糊了。你原本的条件就很多,然后你这句话“就是说表1 F列的花色,如果是H60-H62里面的这三个花色的话,就对应替换成I列60-62的里面的叫法”,我看了好几遍也没理解是什么意思。从字面上我感觉需要对H60-H62的三个特殊花色做特别处理,我不理解的是只有这三个花色呢还是有可能有其他需要特别处理的花色?我这么问是因为你特别指定了H60_h62这个区域,在我的想法里,“产品结构表”的源数据是可能会是变动的,因此特别指定H60_h62可能会有风险,你这次是写在h60_h62区域,或许下一次就变成了h80-h82呢?如果没弄清楚之前我还不好改它;
回复

使用道具 举报

 楼主| 发表于 2019-6-27 11:45 | 显示全部楼层
hfwufanhf2006 发表于 2019-6-27 09:26
1、大小写转换可以做的,用ucase函数,你在代码里把所有的条件比较都加上这个函数,比如
    If Cells(i ...

第二个问题就是你理解的那样,现在是这三个花色需要特别处理的,以后有可能会增加。区域就是固定在这个位置了。后面有增加就会一直在下面再建进去这样子。
回复

使用道具 举报

发表于 2019-6-27 13:35 | 显示全部楼层
zhxj1983 发表于 2019-6-27 11:45
第二个问题就是你理解的那样,现在是这三个花色需要特别处理的,以后有可能会增加。区域就是固定在这个位 ...

Range("i2:p" & [b10000].End(3).Row).ClearContents
Application.ScreenUpdating = False
Dim arr1(100, 2)
js = 0
For i = 60 To Worksheets("产品结构表").Range("h80").End(3).Row
    js = js + 1
    arr1(js, 1) = Worksheets("产品结构表").Cells(i, "h")
    arr1(js, 2) = Worksheets("产品结构表").Cells(i, "i")
Next i
Dim arr
arr = Worksheets("产品结构表").Range("a1:x" & Worksheets("产品结构表").[d10000].End(3).Row)
For i = 2 To [b10000].End(3).Row
    For k = 2 To UBound(arr)
        If UCase(Cells(i, 6)) = UCase(arr(k, 13)) Then
           Cells(i, "i") = arr(k, 14)
        End If
        If UCase(Cells(i, 4)) = UCase(arr(k, 1)) Then
           Cells(i, "j") = arr(k, 2)
        End If
        If UCase(Cells(i, 5)) = UCase(arr(k, 4)) Then
           Cells(i, "k") = arr(k, 5)
           Cells(i, "p") = arr(k, 6)
        End If
        If UCase(Cells(i, 4)) = UCase(arr(k, 16)) Then
           Cells(i, "l") = arr(k, 17)
           Cells(i, "m") = arr(k, 18)
        End If
   Next k
   If Not IsEmpty(Cells(i, "f")) Then
      bz = False
      For j = 1 To js
          If UCase(Cells(i, "f")) = UCase(arr1(j, 1)) Then
             bz = True
             jl = j
             Exit For
          End If
      Next j
      If bz Then
         Cells(i, "n") = arr1(jl, 2) & Cells(i, "l")
      Else
         Cells(i, "n") = Cells(i, "f") & Cells(i, "l")
      End If
   End If
   If Not IsEmpty(Cells(i, "i")) Then
      Cells(i, "o") = Cells(i, "i") & Cells(i, "m")
   End If
   If Not IsEmpty(Cells(i, "j")) Then
      Cells(i, "q") = Cells(i, "j") & Cells(i, "p")
   End If
Next i
Application.ScreenUpdating = True

1、说明:
     判断时不区分大小写,但读取的结果还是源数据,源数据是小写结果也是小写,源数据是大写结果也是大写;
2、增加了特别处理的代码:
读取特别处理的数据区域,目前暂定为h60-h80之间的活动区域
For i = 60 To Worksheets("产品结构表").Range("h80").End(3).Row
    js = js + 1
    arr1(js, 1) = Worksheets("产品结构表").Cells(i, "h")   '转换前的内容
    arr1(js, 2) = Worksheets("产品结构表").Cells(i, "i")    '转换后的内容
Next i


对特别区域进行判断:
      For j = 1 To js   对照数组查询是否为特定区域的数据
          If UCase(Cells(i, "f")) = UCase(arr1(j, 1)) Then
             bz = True
             jl = j
             Exit For
          End If
      Next j
      If bz Then   '如果是特定区域的数据,转换后拼接,转换数据存放在数组 arr1(jl,2) 中
         Cells(i, "n") = arr1(jl, 2) & Cells(i, "l")
      Else            '不是特定区域的数据直接拼接
         Cells(i, "n") = Cells(i, "f") & Cells(i, "l")
      End If



回复

使用道具 举报

 楼主| 发表于 2019-6-28 08:54 | 显示全部楼层
本帖最后由 zhxj1983 于 2019-6-28 09:00 编辑

回复

使用道具 举报

 楼主| 发表于 2019-6-28 09:12 | 显示全部楼层
hfwufanhf2006 发表于 2019-6-27 13:35
Range("i2:p" & .End(3).Row).ClearContents
Application.ScreenUpdating = False
Dim arr1(100, 2)

老师,J列这里,实棕规格有些怪,这里正常是规格才对的,但是有些奇怪又是3E棕加规格,那些有规格的,后面那个棕编码反了。是P+J列组合的,不是J+P,麻烦再看一下
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 17:29 , Processed in 0.425069 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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