ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: leaveLK

[已解决] 借星光老师的文章代码,求一个数据录入系统的VBA代码

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-18 20:24 | 显示全部楼层
请参考
untitled1.png

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-18 21:19 | 显示全部楼层
本帖最后由 leaveLK 于 2020-1-18 21:21 编辑

理解你代码意思了。就是日期这里烦请再改一下:
我手动模拟填了18行数据。你的代码在C2输入的数值只能作为本次录入日期的起始值,如果不修改C2数据,接下来录入的数据都是同一天,但我想代码C列日期逐行加1天,但也不是刚好加1天。(见下图模拟数据表)而是个不连续的、升序的日期,例如( C7 )那天代码生成2019年5月11号,下一行(C8)日期生成2019年5月12号。我设想让有个微调按钮将( C8 )数据改为2019年5月11号,过程如下:
在C4自动生成2019-5-8        采用
在C5自动生成2019-5-9        采用   
在C6自动生成2019-5-10      采用
在C7自动生成2019-5-11      不采用,手动单击C8单元格→激活代码→在右下角弹出“滚动按钮”→向下点击1次→显示2019-5-10
因为C7已手动修改为2019-5-10,所以:
在C8自动生成2019-5-11      采用
在C9自动生成2019-5-12      采用
在C10自动生成2019-5-13     不采用,手动单击C10单元格→激活代码→在右下角弹出“滚动按钮”→向上点击3次→显示2019-5-16
……
以此类推

还有重要的一点,已经录入的数据,如果回头检查,发现录入的项目(D列)有错误需要修改,代码不要自动修改编号和日期。不知道这个实现起来困难不?
7.jpg

我好像要求太多了
单元格内多行录入20200118-改.zip (33.13 KB, 下载次数: 16)

TA的精华主题

TA的得分主题

发表于 2020-1-18 22:08 | 显示全部楼层
本帖最后由 YZC51 于 2020-1-18 23:42 编辑

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Or Target.Row < 4 Then Exit Sub
    If Target(0, 1) = "" Then Exit Sub
    If Target.Column = 4 Then
        If Target <> "" And Target.Row > 3 Then
            Target(1, -2).Value = Target.Row - 3
            If Target.Row = 4 Then
                Target(1, -1) = [B2]
            Else
                Target(1, -1) = Target(0, -1) + 1
            End If
            
            If Target(1, 0) = "" Then
                If Target.Row = 4 Then
                    Target(1, 0) = Date - [C2]
                Else
                    Target(1, 0) = Target(0, 0) + 1
                End If
                '==========================日期列添加数据有效性
                For j = -5 To 5
                    aa = aa & "," & Target(1, 0) + j
                Next
                With Target(1, 0).Validation
                    .Delete
                    .Add Type:=xlValidateList, Formula1:=aa
'                    .Add TxlValidateList, aa
                 End With
                '====================
            End If
               
        End If
    End If
End Sub

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-18 22:35 | 显示全部楼层
YZC51 发表于 2020-1-18 22:08
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Or Target.Row < 4  ...

If Target(1, 0) = "" Then Target(1, 0).Value = Date - [C2]解决了避免数据被覆盖的问题,这个懂起了。
麻烦上面还有个问题,就是日期递增和增加 “数值调节钮”控件可以修改吗?还是我没有描述清楚?

TA的精华主题

TA的得分主题

发表于 2020-1-18 23:43 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-19 01:38 | 显示全部楼层
YZC51 发表于 2020-1-18 23:43
楼上代码已经更新!

没有刷新帖子,不知道你回复了。33楼那个效果达到了,你这里又有新的知识点来了“  .Add Type:=xlValidateList, Formula1:=aa
' .Add TxlValidateList, aa”不明白,因为我纯粹是个VBA新人,这么多肯定够我消化一段时间了。

在看到你的回复之前,我就在你上个版本代码基础上改了下,也算基本达到目的了。
因为那个数值调节按钮的事没有解决我有点不甘心,到处去找例子,终于拼凑了一个出来,请大哥(叫大哥合适不?)指教。

发票报销录入系统20200119-1.zip (37.3 KB, 下载次数: 5)

Private Sub SpinButton1_SpinUp()
' If Target.Column <> 3 Or Target.Row < 3 Then SpinButton1.Visible = False: Exit Sub  这句要运行报错,本意是限制在C列日期数据使用。
ActiveCell.Value = ActiveCell.Value + 1
    With SpinButton1
    ' .Top = Target.Top         '本意想做成浮动按钮,跟随单元格而动,但是没有成功,现在是固定的,
   '  .Left = Target.Left         '暂时只能通过冻结标题栏使用,能不能想listbox一样随单元格点击浮动显示呢?

    .SmallChange = 2       '想设计成日期每点击一次加“2”,实际没有效果。
    End With
End Sub
Private Sub SpinButton1_SpinDown()
' If Target.Column <> 3 Or Target.Row < 3 Then SpinButton1.Visible = False: Exit Sub
ActiveCell.Value = ActiveCell.Value - 1
With SpinButton1
    .SmallChange = 1           '日期每点击一次减“1”,保持不变。
    End With
End Sub


TA的精华主题

TA的得分主题

发表于 2020-1-19 09:09 | 显示全部楼层
leaveLK 发表于 2020-1-19 01:38
没有刷新帖子,不知道你回复了。33楼那个效果达到了,你这里又有新的知识点来了“  .Add Type:=xlValidat ...

做的很好!
请参考,已经浮动啦
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then Exit Sub
    If Target.Column = 3 And Target.Row > 3 And Target <> "" Then
        If Target.Offset(-1, 0).Value <> "" And Target.Value = "" Then
            Target.Value = Target.Offset(-1, 0) + 1
        End If
        With SpinButton1
            .Visible = True
            .Top = Target.Top
            .Left = Target(, 2).Left
        End With
    Else
        SpinButton1.Visible = False
    End If
    If Target.CountLarge > 1 Or Target.Row < 4 Or Target(0, 1) = "" Then ListBox1.Visible = False: Exit Sub  'Then Exit Sub
    If Target.Column = 4 Then                   '如果选中的单元格第4列则
        If Target.CountLarge > 1 Then ListBox1.Visible = False: Exit Sub    '如果选中的单元格大于1个,则退出程序
        With Sheets("源数据")
            r = .Range("A2:C" & .Cells(Rows.Count, "a").End(xlUp).Row).Value
        End With
        With ListBox1                           '调整位置到单元格处
            .Top = Target(2).Top                'listbox的顶端位置下一行
            .Left = Target(, 2).Left            'listbox的左端位置
            .Width = 160                        '宽度
            .Height = 200                       '高度
            .Visible = True                     '可见
            .ColumnHeads = False                '是否显示标题行
            .ColumnCount = 2                    '二列
            .ColumnWidths = "40;100"            '设置第一列宽度40第二列宽度100……
            .List = r                           '数据来源
            .MultiSelect = fmMultiSelectMulti   '允许通过鼠标点击的方式进行多选
            .ListStyle = fmListStyleOption      '选项按钮设置为方形
        End With
    End If
End Sub

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-1-19 09:09 | 显示全部楼层
本帖最后由 YZC51 于 2020-1-19 09:23 编辑

Private Sub SpinButton1_SpinUp()
    ActiveCell.Value = ActiveCell.Value + 2
End Sub

Private Sub SpinButton1_SpinDown()
    ActiveCell.Value = ActiveCell.Value - 1
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-1-19 09:16 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-19 09:52 | 显示全部楼层
YZC51 发表于 2020-1-19 09:09
Private Sub SpinButton1_SpinUp()
    ActiveCell.Value = ActiveCell.Value + 2
End Sub

我自己想加2,公式却写的+1,可能脑子不好用。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-14 14:31 , Processed in 0.050996 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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