Excel精英培训网

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

[已解决]代码目前只能计算H列的,我现在想在同时计算I和J列,一共三列,都是与并列的查找。

[复制链接]
发表于 2016-5-12 10:00 | 显示全部楼层 |阅读模式
本帖最后由 sadz 于 2016-5-17 09:39 编辑

代码目前只能计算H列的,我现在想在同时计算I和J列,一共三列,都是与并列的查找。请问该如何修改
Sub tt()


    arr = Range("a1:h" & [a65536].End(3).Row)
    For k = 3 To UBound(arr) - 1
        x = arr(k, 2): y = arr(k, 8)
        yrr = Split(y, "-")
        For i = 0 To UBound(yrr)
            yy = yrr(i)
            xx = Mid(x, i + 1, 1)
            p = InStr(yy, xx)
            If p > 0 Then Cells(k, 8).Characters(i * 5 + p, 1).Font.ColorIndex = 3
        Next
    Next
End Sub
附件上传下
各位置胆遗漏排序 变色.zip (258.56 KB, 下载次数: 16)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2016-5-12 13:23 | 显示全部楼层
回复

使用道具 举报

发表于 2016-5-13 09:42 | 显示全部楼层    本楼为最佳答案   
  1. Sub 标色()
  2.     arr = Range("a1:j" & [a65536].End(3).Row)
  3.     For k = 4 To UBound(arr) - 1
  4.         x = arr(k, 2)
  5.         For j = 8 To 10
  6.             y = arr(k, j)
  7.             yrr = Split(y, "-")
  8.             For i = 0 To UBound(yrr)
  9.                 yy = yrr(i)
  10.                 xx = Mid(x, i + 1, 1)
  11.                 p = InStr(yy, xx)
  12.                 If p > 0 Then Cells(k, j).Characters(i * 5 + p, 1).Font.ColorIndex = 3
  13.             Next
  14.         Next
  15.     Next
  16. End Sub
复制代码

评分

参与人数 1 +1 收起 理由
sadz + 1 神马都是浮云

查看全部评分

回复

使用道具 举报

发表于 2016-5-13 10:29 | 显示全部楼层
  1. Public arr
  2. Sub tt()
  3.     Dim k As Long
  4.     arr = Range("a1:j" & [a65536].End(3).Row)
  5.     Application.ScreenUpdating = False
  6.        Call getArr(2, 8)
  7.        Call getArr(2, 9)
  8.        Call getArr(2, 10)
  9.     Application.ScreenUpdating = True
  10. End Sub

  11. Sub getArr(n As Integer, m As Integer)
  12. For k = 4 To UBound(arr) - 1
  13.     x = arr(k, n)
  14.     y = arr(k, m)
  15.     yrr = Split(y, "-")
  16.     For i = 0 To UBound(yrr)
  17.         yy = yrr(i)
  18.         xx = Mid(x, i + 1, 1)
  19.         p = InStr(yy, xx)
  20.         If p > 0 Then Cells(k, m).Characters(i * 5 + p, 1).Font.ColorIndex = 3
  21.     Next
  22. Next
  23. End Sub
复制代码

评分

参与人数 1 +1 收起 理由
sadz + 1 很给力

查看全部评分

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 06:57 , Processed in 0.318284 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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