[已解决]此表可用但求精简录入按的代码

syt188702

回复 zjdh 的帖子

zjdh老师，实验了下，利用贷款帐号里一个帐号记录下
出现编译错误
END IF 没有 IF  块

syt188702

回复 zjdh 的帖子

zjdh老师辛苦你了我删除了最一个END  IF 故障消除了，因电不稳不知能否测试完成，我准备放到我的正式表里

syt188702

回复 zjdh 的帖子

zjdh老师辛苦你了，谢谢这里还有一个要求原来有句，If Sheets("录入表").Cells(2, 3) <> "" And Sheets("录入表").Cells(2, 4) <> "" Then
能否同我加进去吗，要一个条件不会造成不全，电压不稳，总是重启

syt188702

回复 zjdh 的帖子

ZJDH老师，您的代码有一部分是好的，每次录入数据总是在第一条记录，上复盖，选择的记录录入发生额后就复盖B2行的记录
原记录不是原来的位置，总个数据表记录完全后，只有一条记录了全覆盖了

zjdh

我修改完了没有测试，所以叫你测试。

zjdh

我没注意，你的数据表A列是空白的修改一下：
Sub 录入数据()
    Application.ScreenUpdating = False    '关闭屏幕刷新
    With Sheets("录入表")
        If .Cells(2, 2) = "" Then
            .Cells(3, 2) = "空白表不能调用"
        Else
            辅助到流水
            Set SJB = Sheets("数据表")
            Set XJL = Sheets("现金流水")
            x = SJB.Range("B65536").End(3).Row + 1
            For i = 2 To 15
                SJB.Cells(x, i) = .Cells(2, i)  '记帐日期
            Next
            SJB.Cells(x, 49) = .Cells(2, 16)    '科目调整日期
            For i = 16 To 28
                SJB.Cells(x, i) = .Cells(4, i - 13)  '收回金额
            Next
            SJB.Cells(x, 88) = .Cells(4, 16)    '客户经理
            For i = 29 To 38
                SJB.Cells(x, i) = .Cells(6, i - 23)  '起息日期
            Next
            SJB.Cells(x, 89) = .Cells(6, 16)    '信用等级
            For i = 39 To 48
                SJB.Cells(x, i) = .Cells(8, i - 33)  '利息
            Next
            SJB.Cells(x, 90) = .Cells(8, 16)    ' 授信金额
            For i = 50 To 55
                SJB.Cells(x, i) = .Cells(10, i - 44)  '责任人
            Next
            SJB.Cells(x, 87) = .Cells(10, 15)    '收回信贷员
            SJB.Cells(x, 91) = .Cells(10, 16)    '联系电话
            For i = 59 To 69
                SJB.Cells(x, i) = .Cells(12, i - 53)  '科目调整
            Next
            SJB.Cells(x, 86) = .Cells(12, 3)    '展期或再融资
            SJB.Cells(x, 58) = .Cells(10, 2)    '综合业务帐号
            SJB.Cells(x, 56) = .Cells(6, 2)    '身份证
            SJB.Cells(x, 57) = .Cells(8, 2)    '地址
            y = XJL.Range("A65536").End(xlUp).Row + 1
            XJL.Cells(y, 1) = .Cells(2, 2)    '借款帐号
            XJL.Cells(y, 2) = .Cells(2, 3)    '借款单位
            XJL.Cells(y, 3) = .Cells(2, 4)  '借据号码
            XJL.Cells(y, 4) = .Cells(2, 17)    '记帐日期
            XJL.Cells(y, 5) = .Cells(4, 17)    '收回金额
            XJL.Cells(y, 6) = .Cells(8, 17)    '利息
            XJL.Cells(y, 7) = .Cells(10, 17)    '收回信贷员
            XJL.Cells(y, 8) = .Cells(10, 8)    '贷款日期
            XJL.Cells(y, 9) = .Cells(10, 9)    '到期日期
            XJL.Cells(y, 10) = .Cells(10, 10)   '利率
        End If
        .Range("B2:O2,C4:O4,F6:O6,F8:O8,F10:K10,F12:O12,C11,C12,B6,B8,B10,O10,p2,p4,p6,p8,p10,p12,q2:q8") = ""
        .Cells(3, 2) = "录入成功！！"
    End With
    起息日期74
    起息日期81
    Application.ScreenUpdating = True     '打开屏幕刷新
End Sub

syt188702

回复 zjdh 的帖子

ZJDH老师，我测试了一下，
1、数据表中记帐，记录的帐号不是唯一，调用原数据表中的记录，记录新发生额时，
会产生同一帐号的新记录并把这条记录，记录在数据表的最后一个不为空的行，这是不符合我的题意的。
2、我的要求 是：记录新客户，记录在最后一个不为空的行，
                        记录老客户（有帐号的客户），在不修改原记录的情况下，在相同项目
（如：在记帐日期项：第一有数据，就添加在记帐日期1里）要求下记录在不为空的相邻单元格添加记录
3、录数据表中的每一条记录不能产生重复帐号，有记录只能修改数据、不另取一行增加新的一行同帐号记录。
    新开户时在最后一行不为空的行产生新记录。录入表中的单元格同数据表单元格的录入项是相的

syt188702

回复 zjdh 的帖子

zjdh老师：这是原来的一段代码，我是强行实践而成的，不知为什么在这样，但在这而有用，添加此段代码
Dim i, x, flag
    x = 2
    If Sheets("录入表").Cells(2, 3) <> "" And Sheets("录入表").Cells(2, 4) <> "" Then
    Do While Not (IsEmpty(Sheets("数据表").Cells(x, 2).Value))
        x = x + 1
    Loop
   
    flag = 0
    For i = 1 To x
        If Sheets("数据表").Cells(i, 2) = Sheets("录入表").Cells(2, 2) Then
            flag = 14
            Exit For
        End If
    Next
   
    If flag = 14 Then
        x = i
    End If
删除 ' x = SJB.Range("B65536").End(3).Row + 1
就可以了，老师能否讲一下工作原理,j

zjdh

你附件中不是说：
..........向数据表添加数据时有重复贷款帐号下移不覆盖
..........有重复数据就被新的覆盖，能否让不覆盖，增加一行数据

zjdh

你启用了18楼那段代码，不就和原来一样啦？？