借星光老师的文章代码，求一个数据录入系统的VBA代码

YZC51

请参考

leaveLK

YZC51 发表于 2020-1-18 20:24
请参考

理解你代码意思了。就是日期这里烦请再改一下：
我手动模拟填了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列）有错误需要修改，代码不要自动修改编号和日期。不知道这个实现起来困难不？


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

2020-1-18 21:21 上传

点击文件名下载附件

YZC51

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

leaveLK

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]解决了避免数据被覆盖的问题，这个懂起了。
麻烦上面还有个问题，就是日期递增和增加 “数值调节钮”控件可以修改吗？还是我没有描述清楚？

YZC51

楼上代码已经更新！

leaveLK

YZC51 发表于 2020-1-18 23:43
楼上代码已经更新！

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

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

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

2020-1-19 01:36 上传

点击文件名下载附件

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

YZC51

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

YZC51

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

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

YZC51

代码审核中

leaveLK

YZC51 发表于 2020-1-19 09:09
Private Sub SpinButton1_SpinUp()
    ActiveCell.Value = ActiveCell.Value + 2
End Sub

我自己想加2，公式却写的+1，可能脑子不好用。