设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 求助加一个条件下字段单元格数据部相同时不记录
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2248|回复: 7

[已解决]求助加一个条件下字段单元格数据部相同时不记录

[复制链接]
发表于 2011-8-20 06:47 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
Sub 录入数据1()
'Zjdh老师
Application.ScreenUpdating = False    '关闭屏幕刷新
Dim i, x, flag
If Sheets("录入表").Cells(2, 3) <> "" And Sheets("录入表").Cells(2, 4) <> "" Then    '贷款单位、借据号码不为空时
        x = Sheets("数据表").Cells(65536, 2).End(3).Row  '数据表末行
        flag = 0     '标识清零
        For i = 2 To x     '逐个比较
            If Sheets("录入表").Cells(2, 2) = Sheets("数据表").Cells(i, 2) Then  '贷款帐号相同时
                flag = 1      '标识
                Exit For       '退出比较
            End If
        Next
        If flag Then         '标识不为0
            x = i         'X为相同贷款帐号的行号
        Else
            x = x + 1
        End If
    End If
    With Sheets("录入表")
        If .Cells(2, 2) = "" Then
            .Cells(3, 2) = "空白表不能调用"
        Else
            辅助到流水1
            Set SJB = Sheets("数据表")
            Set XJL = Sheets("现金流水")
           ' x = SJB.Range("B65536").End(3).Row + 1
           '如果新客户就执行X+1 如果是旧客户执行标示比较X不变
            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 68
                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)    '地址
            请老师在此添加一个条件所有字段数据相同时不添加中止，否则执行向XJL表添加数据
                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, 15)    '收回信贷员
                XJL.Cells(y, 8) = .Cells(10, 8)    '贷款日期
                XJL.Cells(y, 9) = .Cells(10, 9)    '到期日期
                XJL.Cells(y, 10) = .Cells(10, 10)   '利率
                XJL.Cells(y, 12) = Sheets("录入表").Cells(10, 17) '凭证号码起
                XJL.Cells(y, 13) = Sheets("录入表").Cells(12, 17) '凭证号码止
                XJL.Cells(y, 16) = Sheets("录入表").Cells(12, 16) '新贷款科目
          End If
         Sheets("录入表").Range("B2:Q2,C4:Q4,F6:Q6,F8:Q8,F10:K10,O10:Q10,F12:Q12,B6,B8,B10,C11,C12") = ""
        .Cells(3, 2) = "录入成功！！"
    End With
    起息日期741
    起息日期811
    Application.ScreenUpdating = True     '打开屏幕刷新
    Application.Calculation = xlCalculationAutomatic    '自动重算
End Sub
最佳答案
月排行榜 / 总排行榜
zjdh
2011-8-20 08:14
本帖最后由 zjdh 于 2011-8-20 08:19 编辑
  1. Sub 录入数据1()
  2. 'Zjdh老师
  3.     Application.ScreenUpdating = False    '关闭屏幕刷新
  4.     Dim i, x, flag
  5.     If Sheets("录入表").Cells(2, 3) <> "" And Sheets("录入表").Cells(2, 4) <> "" Then    '贷款单位、借据号码不为空时
  6.         x = Sheets("数据表").Cells(65536, 2).End(3).Row  '数据表末行
  7.         flag = 0     '标识清零
  8.         For i = 2 To x     '逐个比较
  9.             If Sheets("录入表").Cells(2, 2) = Sheets("数据表").Cells(i, 2) Then  '贷款帐号相同时
  10.                 flag = 1      '标识
  11.                 Exit For       '退出比较
  12.             End If
  13.         Next
  14.         If flag Then         '标识不为0
  15.             x = i         'X为相同贷款帐号的行号
  16.         Else
  17.             x = x + 1
  18.         End If
  19.     End If
  20.     With Sheets("录入表")
  21.         If .Cells(2, 2) = "" Then
  22.             .Cells(3, 2) = "空白表不能调用"
  23.         Else
  24.             辅助到流水1
  25.             Set SJB = Sheets("数据表")
  26.             Set XJL = Sheets("现金流水")
  27.             ' x = SJB.Range("B65536").End(3).Row + 1
  28.             '如果新客户就执行X+1 如果是旧客户执行标示比较X不变
  29.             For i = 2 To 15
  30.                 SJB.Cells(x, i) = .Cells(2, i)  '记帐日期
  31.             Next
  32.             SJB.Cells(x, 49) = .Cells(2, 16)    '科目调整日期
  33.             For i = 16 To 28
  34.                 SJB.Cells(x, i) = .Cells(4, i - 13)  '收回金额
  35.             Next
  36.             SJB.Cells(x, 88) = .Cells(4, 16)    '客户经理
  37.             For i = 29 To 38
  38.                 SJB.Cells(x, i) = .Cells(6, i - 23)  '起息日期
  39.             Next
  40.             SJB.Cells(x, 89) = .Cells(6, 16)    '信用等级
  41.             For i = 39 To 48
  42.                 SJB.Cells(x, i) = .Cells(8, i - 33)  '利息
  43.             Next
  44.             SJB.Cells(x, 90) = .Cells(8, 16)    ' 授信金额
  45.             For i = 50 To 55
  46.                 SJB.Cells(x, i) = .Cells(10, i - 44)  '责任人
  47.             Next
  48.             SJB.Cells(x, 87) = .Cells(10, 15)    '收回信贷员
  49.             SJB.Cells(x, 91) = .Cells(10, 16)    '联系电话
  50.             For i = 59 To 68
  51.                 SJB.Cells(x, i) = .Cells(12, i - 53)  '科目调整
  52.             Next
  53.             SJB.Cells(x, 86) = .Cells(12, 3)    '展期或再融资
  54.             SJB.Cells(x, 58) = .Cells(10, 2)    '综合业务帐号
  55.             SJB.Cells(x, 56) = .Cells(6, 2)    '身份证
  56.             SJB.Cells(x, 57) = .Cells(8, 2)    '地址
  57.             y = XJL.Range("A65536").End(xlUp).Row + 1
  58.             '***判断****
  59.             For i = 2 To y - 1
  60.                 If XJL.Cells(i, 1) = .Cells(2, 2) Then
  61.                     s = 1
  62.                     If XJL.Cells(i, 2) = .Cells(2, 3) Then s = s + 1
  63.                     If XJL.Cells(i, 3) = .Cells(2, 4) Then s = s + 1
  64.                     If XJL.Cells(i, 4) = .Cells(2, 17) Then s = s + 1
  65.                     If XJL.Cells(i, 5) = .Cells(4, 17) Then s = s + 1
  66.                     If XJL.Cells(i, 6) = .Cells(8, 17) Then s = s + 1
  67.                     If XJL.Cells(i, 7) = .Cells(10, 15) Then s = s + 1
  68.                     If XJL.Cells(i, 8) = .Cells(10, 8) Then s = s + 1
  69.                     If XJL.Cells(i, 9) = .Cells(10, 9) Then s = s + 1
  70.                     If XJL.Cells(i, 10) = .Cells(10, 10) Then s = s + 1
  71.                     If XJL.Cells(i, 12) = .Cells(10, 17) Then s = s + 1
  72.                     If XJL.Cells(i, 13) = .Cells(12, 17) Then s = s + 1
  73.                     If XJL.Cells(i, 16) = .Cells(12, 16) Then s = s + 1
  74.                 End If
  75.                 If s = 13 Then Exit For
  76.             Next
  77.             '******
  78.             If s <> 13 Then
  79.                 XJL.Cells(y, 1) = .Cells(2, 2)    '借款帐号
  80.                 XJL.Cells(y, 2) = .Cells(2, 3)    '借款单位
  81.                 XJL.Cells(y, 3) = .Cells(2, 4)     '借据号码
  82.                 XJL.Cells(y, 4) = .Cells(2, 17)    '记帐日期
  83.                 XJL.Cells(y, 5) = .Cells(4, 17)    '收回金额
  84.                 XJL.Cells(y, 6) = .Cells(8, 17)    '利息
  85.                 XJL.Cells(y, 7) = .Cells(10, 15)    '收回信贷员
  86.                 XJL.Cells(y, 8) = .Cells(10, 8)    '贷款日期
  87.                 XJL.Cells(y, 9) = .Cells(10, 9)    '到期日期
  88.                 XJL.Cells(y, 10) = .Cells(10, 10)   '利率
  89.                 XJL.Cells(y, 12) = .Cells(10, 17)    '凭证号码起
  90.                 XJL.Cells(y, 13) = .Cells(12, 17)    '凭证号码止
  91.                 XJL.Cells(y, 16) = .Cells(12, 16)    '新贷款科目
  92.             End If
  93.         End If
  94.         Sheets("录入表").Range("B2:Q2,C4:Q4,F6:Q6,F8:Q8,F10:K10,O10:Q10,F12:Q12,B6,B8,B10,C11,C12") = ""
  95.         .Cells(3, 2) = "录入成功！！"
  96.     End With
  97.     起息日期741
  98.     起息日期811
  99.     Application.ScreenUpdating = True     '打开屏幕刷新
  100. End Sub
复制代码
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
 楼主| 发表于 2011-8-20 07:37 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
               XJL.Cells(x, 1) <> .Cells(2, 2) And XJL.Cells(x, 2) <> .Cells(2, 3) And XJL.Cells(x, 3) = .Cells(2, 4) _
                And XJL.Cells(x, 4) <> .Cells(2, 17) And XJL.Cells(x, 5) <> .Cells(4, 17) And XJL.Cells(x, 6) <> .Cells(8, 17) _
                And XJL.Cells(x, 7) <> .Cells(10, 15) And XJL.Cells(x, 8) = .Cells(10, 8) And XJL.Cells(x, 9) = .Cells(10, 9) _
                And XJL.Cells(x, 10) <> .Cells(10, 10) And XJL.Cells(x, 12) <> Sheets("录入表").Cells(10, 17) And XJL.Cells(x, 13) <> Sheets("录入表").Cells(12, 17) _
                And XJL.Cells(x, 16) <> Sheets("录入表").Cells(12, 16) Then 在现金流水中添加新数据，否则中止，下面的代码程序结束。
条件是这样的不知道用什么方法加入可以运行
回复

使用道具 举报

zjdh
发表于 2011-8-20 08:14 | 显示全部楼层    本楼为最佳答案   
工作中最常用的Excel函数公式，全印在一张鼠标垫上
本帖最后由 zjdh 于 2011-8-20 08:19 编辑
  1. Sub 录入数据1()
  2. 'Zjdh老师
  3.     Application.ScreenUpdating = False    '关闭屏幕刷新
  4.     Dim i, x, flag
  5.     If Sheets("录入表").Cells(2, 3) <> "" And Sheets("录入表").Cells(2, 4) <> "" Then    '贷款单位、借据号码不为空时
  6.         x = Sheets("数据表").Cells(65536, 2).End(3).Row  '数据表末行
  7.         flag = 0     '标识清零
  8.         For i = 2 To x     '逐个比较
  9.             If Sheets("录入表").Cells(2, 2) = Sheets("数据表").Cells(i, 2) Then  '贷款帐号相同时
  10.                 flag = 1      '标识
  11.                 Exit For       '退出比较
  12.             End If
  13.         Next
  14.         If flag Then         '标识不为0
  15.             x = i         'X为相同贷款帐号的行号
  16.         Else
  17.             x = x + 1
  18.         End If
  19.     End If
  20.     With Sheets("录入表")
  21.         If .Cells(2, 2) = "" Then
  22.             .Cells(3, 2) = "空白表不能调用"
  23.         Else
  24.             辅助到流水1
  25.             Set SJB = Sheets("数据表")
  26.             Set XJL = Sheets("现金流水")
  27.             ' x = SJB.Range("B65536").End(3).Row + 1
  28.             '如果新客户就执行X+1 如果是旧客户执行标示比较X不变
  29.             For i = 2 To 15
  30.                 SJB.Cells(x, i) = .Cells(2, i)  '记帐日期
  31.             Next
  32.             SJB.Cells(x, 49) = .Cells(2, 16)    '科目调整日期
  33.             For i = 16 To 28
  34.                 SJB.Cells(x, i) = .Cells(4, i - 13)  '收回金额
  35.             Next
  36.             SJB.Cells(x, 88) = .Cells(4, 16)    '客户经理
  37.             For i = 29 To 38
  38.                 SJB.Cells(x, i) = .Cells(6, i - 23)  '起息日期
  39.             Next
  40.             SJB.Cells(x, 89) = .Cells(6, 16)    '信用等级
  41.             For i = 39 To 48
  42.                 SJB.Cells(x, i) = .Cells(8, i - 33)  '利息
  43.             Next
  44.             SJB.Cells(x, 90) = .Cells(8, 16)    ' 授信金额
  45.             For i = 50 To 55
  46.                 SJB.Cells(x, i) = .Cells(10, i - 44)  '责任人
  47.             Next
  48.             SJB.Cells(x, 87) = .Cells(10, 15)    '收回信贷员
  49.             SJB.Cells(x, 91) = .Cells(10, 16)    '联系电话
  50.             For i = 59 To 68
  51.                 SJB.Cells(x, i) = .Cells(12, i - 53)  '科目调整
  52.             Next
  53.             SJB.Cells(x, 86) = .Cells(12, 3)    '展期或再融资
  54.             SJB.Cells(x, 58) = .Cells(10, 2)    '综合业务帐号
  55.             SJB.Cells(x, 56) = .Cells(6, 2)    '身份证
  56.             SJB.Cells(x, 57) = .Cells(8, 2)    '地址
  57.             y = XJL.Range("A65536").End(xlUp).Row + 1
  58.             '***判断****
  59.             For i = 2 To y - 1
  60.                 If XJL.Cells(i, 1) = .Cells(2, 2) Then
  61.                     s = 1
  62.                     If XJL.Cells(i, 2) = .Cells(2, 3) Then s = s + 1
  63.                     If XJL.Cells(i, 3) = .Cells(2, 4) Then s = s + 1
  64.                     If XJL.Cells(i, 4) = .Cells(2, 17) Then s = s + 1
  65.                     If XJL.Cells(i, 5) = .Cells(4, 17) Then s = s + 1
  66.                     If XJL.Cells(i, 6) = .Cells(8, 17) Then s = s + 1
  67.                     If XJL.Cells(i, 7) = .Cells(10, 15) Then s = s + 1
  68.                     If XJL.Cells(i, 8) = .Cells(10, 8) Then s = s + 1
  69.                     If XJL.Cells(i, 9) = .Cells(10, 9) Then s = s + 1
  70.                     If XJL.Cells(i, 10) = .Cells(10, 10) Then s = s + 1
  71.                     If XJL.Cells(i, 12) = .Cells(10, 17) Then s = s + 1
  72.                     If XJL.Cells(i, 13) = .Cells(12, 17) Then s = s + 1
  73.                     If XJL.Cells(i, 16) = .Cells(12, 16) Then s = s + 1
  74.                 End If
  75.                 If s = 13 Then Exit For
  76.             Next
  77.             '******
  78.             If s <> 13 Then
  79.                 XJL.Cells(y, 1) = .Cells(2, 2)    '借款帐号
  80.                 XJL.Cells(y, 2) = .Cells(2, 3)    '借款单位
  81.                 XJL.Cells(y, 3) = .Cells(2, 4)     '借据号码
  82.                 XJL.Cells(y, 4) = .Cells(2, 17)    '记帐日期
  83.                 XJL.Cells(y, 5) = .Cells(4, 17)    '收回金额
  84.                 XJL.Cells(y, 6) = .Cells(8, 17)    '利息
  85.                 XJL.Cells(y, 7) = .Cells(10, 15)    '收回信贷员
  86.                 XJL.Cells(y, 8) = .Cells(10, 8)    '贷款日期
  87.                 XJL.Cells(y, 9) = .Cells(10, 9)    '到期日期
  88.                 XJL.Cells(y, 10) = .Cells(10, 10)   '利率
  89.                 XJL.Cells(y, 12) = .Cells(10, 17)    '凭证号码起
  90.                 XJL.Cells(y, 13) = .Cells(12, 17)    '凭证号码止
  91.                 XJL.Cells(y, 16) = .Cells(12, 16)    '新贷款科目
  92.             End If
  93.         End If
  94.         Sheets("录入表").Range("B2:Q2,C4:Q4,F6:Q6,F8:Q8,F10:K10,O10:Q10,F12:Q12,B6,B8,B10,C11,C12") = ""
  95.         .Cells(3, 2) = "录入成功！！"
  96.     End With
  97.     起息日期741
  98.     起息日期811
  99.     Application.ScreenUpdating = True     '打开屏幕刷新
  100. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2011-8-20 08:24 | 显示全部楼层
回复 zjdh 的帖子

谢谢zjdh老师，解决了，运行录入代码，数据行数多时，时间长，光标闪烁几下
回复

使用道具 举报

 楼主| 发表于 2011-8-22 13:02 | 显示全部楼层
回复 zjdh 的帖子

zjdh老师你好，现触发了一个新问题，
1、当录入表没有数据时，点击了录入按钮后，代码就不会停止。
2、想加入一个代码，“数据正在录入，请稍后.......”
3、因数据表数据行有5000多笔，在点录入时，光标自动闪烁，录入数据时间长
回复

使用道具 举报

zjdh
发表于 2011-8-22 13:44 | 显示全部楼层
本帖最后由 zjdh 于 2011-8-22 13:44 编辑

你把你现在用的文件传给我，以免修改不到位。
数据采用模拟的。
Email:dh_dq@163.com
回复

使用道具 举报

 楼主| 发表于 2011-8-22 14:32 | 显示全部楼层
回复 zjdh 的帖子

zjdh老师，我正在上传有10多m
回复

使用道具 举报

 楼主| 发表于 2011-8-22 14:40 | 显示全部楼层
回复 zjdh 的帖子

zjdh老师，邮件已发，请收阅
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-25 09:08 , Processed in 0.366727 second(s), 7 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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