ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 活动单元格 值替换问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-12-18 12:44 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.OnKey "{Enter}"
f = ActiveCell.Value           '读出当前活动单元格值

If f = "" Then End             ' 如果当前活动单元格值为空,即退出
If Target.Column = 2 Then             '如果是当前活动单元格为 2 列,就……
If IsNumeric(ActiveCell) Then            '如果是当前活动单元格为 数值,就……
'Application.OnKey "{Enter}", "test"
Select Case f

Case 1
ActiveCell = "中国********人民"
Case 2
ActiveCell = "美利坚联邦%%%%%%%"
Case 3
ActiveCell = "日本岛屿#########33"
Case 4
ActiveCell = "%%%%%%………………&&&&&"
Case 5
ActiveCell = "@@#@#@#¥%%"
Case 6
ActiveCell = "……¥#%%#¥&&&&"
Case Is > 6
ActiveCell = ""

End Select

End If
End If
End Sub
问题:
在 B3 录入 1 后回车,不能立即转成对应的文本。必须重点一下B3 才有效。

能否把VBA 改成只要敲一下回车,原数值立即替换指定文本。



传递表1.zip

17.93 KB, 下载次数: 5

TA的精华主题

TA的得分主题

发表于 2018-12-18 12:52 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. f = ActiveCell.Value           '读出当前活动单元格值

  3. If f = "" Then End             ' 如果当前活动单元格值为空,即退出
  4. If Target.Column = 2 Then             '如果是当前活动单元格为 2 列,就……
  5. If IsNumeric(ActiveCell) Then            '如果是当前活动单元格为 数值,就……
  6. 'Application.OnKey "{Enter}", "test"
  7. Application.EnableEvents = False
  8. Select Case f

  9. Case 1
  10. ActiveCell = "中国********人民"

  11. Case 2
  12. ActiveCell = "美利坚联邦%%%%%%%"
  13.    
  14. Case 3
  15. ActiveCell = "日本岛屿#########33"


  16. Case 4
  17. ActiveCell = "%%%%%%………………&&&&&"


  18. Case 5
  19. ActiveCell = "@@#@#@#¥%%"


  20. Case 6
  21. ActiveCell = "……¥#%%#¥&&&&"


  22. Case Is > 6
  23. ActiveCell = ""

  24. End Select
  25. Application.EnableEvents = True
  26. End If
  27. End If

  28. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-18 13:06 | 显示全部楼层
本帖最后由 丢丢表格 于 2018-12-18 13:09 编辑

老师好!

敲回车时,下一行的单元格值变化了,而原来的单元格没变
  (敲回车后,下面的单元可成了当前活动单元格了,这个问题 如何解决?)

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-18 13:51 | 显示全部楼层

Private Sub Worksheet_Change(ByVal Target As Range)
F = ActiveCell.Value           '读出当前活动单元格值

ROWA = Target.Row                  '读出当前活动格的行号
If Cells(ROWA, 2) = "" Then End       '如果是当前活动单元格为 空值,就退出
If Target.Column = 2 Then             '如果是当前活动单元格为 2 列,就……
If IsNumeric(Cells(ROWA, 2)) Then            '如果是当前活动单元格为 数值,就……

Select Case Cells(ROWA, 2)
Case 1
Cells(ROWA, 2) = "中国********人民"
Case 2
Cells(ROWA, 2) = "美利坚联邦%%%%%%%"
Case 3
Cells(ROWA, 2) = "日本岛屿#########33"
Case 4
Cells(ROWA, 2) = "%%%%%%………………&&&&&"
Case 5
Cells(ROWA, 2) = "@@#@#@#¥%%"
Case 6
Cells(ROWA, 2) = "……¥#%%#¥&&&&"
Case Is > 6
Cells(ROWA, 2) = ""

End Select
End If
End If

End Sub

   改成这样后就OK 了。
  因为 敲回车后 当前行位置就变了

  多谢老师的指导



TA的精华主题

TA的得分主题

发表于 2018-12-18 14:12 | 显示全部楼层
丢丢表格 发表于 2018-12-18 13:06
老师好!

敲回车时,下一行的单元格值变化了,而原来的单元格没变

把你原来的事件代码注释掉
就留刚才我传的代码看看

TA的精华主题

TA的得分主题

发表于 2018-12-18 15:32 | 显示全部楼层
丢丢表格 发表于 2018-12-18 13:51
Private Sub Worksheet_Change(ByVal Target As Range)
F = ActiveCell.Value           '读出当前活动 ...

这种还是用字典处理好一点。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-18 16:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
liulang0808 发表于 2018-12-18 14:12
把你原来的事件代码注释掉
就留刚才我传的代码看看

我限定 回车向右了 ,你写的VBA 通不过测试。
谢老师了

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-18 16:35 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
lsc900707 发表于 2018-12-18 15:32
这种还是用字典处理好一点。

这就是一个 相当于下拉菜单, 用数值表达,最后替换成 文本串。所要替换的内容不多,也只有 20 个,就是打字有点多,所以想个偷懒方法。

如果用 公式的话,可能会很卡,因为数据是天天增加的(一天200条左右, 一年下来就有点多了),所以须用VBA 写。

TA的精华主题

TA的得分主题

发表于 2018-12-18 20:08 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
丢丢表格 发表于 2018-12-18 16:35
这就是一个 相当于下拉菜单, 用数值表达,最后替换成 文本串。所要替换的内容不多,也只有 20 个,就是 ...

我的意思是这样,请参考测试附件:

传递表1.rar

18.89 KB, 下载次数: 11

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-12-19 08:55 | 显示全部楼层
lsc900707 发表于 2018-12-18 20:08
我的意思是这样,请参考测试附件:

这种字典方法是可行,不过表方的要求 不用设对照表,因为这20个值是固定不变的。从VBA 中调出即可。
谢谢老师的回复,且学到了一个字典方法。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 15:28 , Processed in 0.062759 second(s), 14 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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