ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 635|回复: 7

[求助] 求大神帮忙处理一下这个数据

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-3-2 21:23 | 显示全部楼层 |阅读模式
B,D,F列为数据列,且只有数字1或2.A,C,E列为标记列。当B,D,F列中连续出现4个2,或者大于4个2时,需要在对应的A,C,E列中把这些2标记出来。如图所示。
附件里面已经全部标上,但是手工太难,请老师教我。帮我做一个VBA。多谢啦。感激不尽呢。
求大神帮忙.png

求大神帮忙.rar

15.26 KB, 下载次数: 6

TA的精华主题

TA的得分主题

发表于 2020-3-2 21:28 | 显示全部楼层
就是对应的2之间填充颜色吧?

TA的精华主题

TA的得分主题

发表于 2020-3-2 22:02 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
描述得不清不楚,还好有贴图:
分别找出B、D和F列不被数值1分隔的数值2的个数,若数值2的个数连续存在4个及以上,则在该起止区域的左侧列的对应区域填充黄底色。

参考下列代码:
  1. Sub kkk()
  2.     Dim theFinalRow&, i&, j&, k&, m&, n&, theCell As Range
  3.     Dim arr As Variant, theCount&
  4.     '
  5.     With ActiveSheet
  6.         For i = 1 To 5 Step 2
  7.             .Columns(i).Interior.ColorIndex = -4142
  8.         Next i
  9.         '
  10.         With .Columns("A:F")
  11.             Set theCell = .Find("*", .Cells(1), xlValues, xlPart, xlByRows, xlPrevious, False, False, False)
  12.         End With
  13.         '
  14.         If Not theCell Is Nothing Then
  15.             theFinalRow = theCell.Row
  16.         Else
  17.             GoTo The_Exit
  18.         End If
  19.         '
  20.         arr = .Range(.Cells(1, 1), .Cells(theFinalRow, 6))
  21.         For j = 2 To 6 Step 2
  22.             For i = 1 To UBound(arr)
  23.                 If arr(i, j) = 2 Then
  24.                     k = i
  25.                     m = k
  26.                     theCount = 1
  27.                     Do While m < theFinalRow
  28.                         m = m + 1
  29.                         If arr(m, j) = 2 Then
  30.                             theCount = theCount + 1
  31.                             n = m
  32.                         Else
  33.                             If arr(m, j) = 1 Then Exit Do
  34.                         End If
  35.                     Loop
  36.                     i = m
  37.                     '
  38.                     If theCount > 3 Then .Range(.Cells(k, j - 1), .Cells(n, j - 1)).Interior.ColorIndex = 6
  39.                 End If
  40.             Next i
  41.         Next j
  42.     End With
  43. The_Exit:
  44.     Set theCell = Nothing
  45. End Sub
复制代码


评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-3-2 23:09 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 zzj198237 于 2020-3-2 23:57 编辑

image.png
  1. <blockquote>Sub test(col As Long, sh As Worksheet) 'col需要处理的列,sh为出来的表格
复制代码

数学不好都不好意思逛论坛了
满意就上鲜花

数据填入表.zip

10.44 KB, 下载次数: 1

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-3 10:48 | 显示全部楼层
gbgbxgb 发表于 2020-3-2 22:02
描述得不清不楚,还好有贴图:
分别找出B、D和F列不被数值1分隔的数值2的个数,若数值2的个数连续存在4个 ...

太感谢您啦,完美的解决了我的问题。多谢大神啦!!!
这个我不太会描述,就结合图啦。不好意思呢。
多谢大神帮我大忙了。感恩感谢

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-3 10:51 | 显示全部楼层
zzj198237 发表于 2020-3-2 23:09
数学不好都不好意思逛论坛了
满意就上鲜花

附件里的跟主题没有关系,估计是您选择错了吧。代码就一句话,也用不了的。
不过还是谢谢您能回复。
123.png

TA的精华主题

TA的得分主题

发表于 2020-3-3 10:58 | 显示全部楼层
xinghuasking 发表于 2020-3-3 10:51
附件里的跟主题没有关系,估计是您选择错了吧。代码就一句话,也用不了的。
不过还是谢谢您能回复。

附件传错了

自动填充(2020年3月3日).rar

46.63 KB, 下载次数: 1

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-3-3 11:10 | 显示全部楼层
感觉写代码还没有ACE列公式做标记省事,如果ACE可以用,输入公式做标记,根据标记条件个格式可以吗?
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 23:12 , Processed in 0.050682 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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