至关重要的Range对象，我的核心！

OKJSJSF · 发表于 2018-5-12 15:32

为了适应“大数据”需要，从去年10月开始，经过半年的学习、抄袭、修改，终于完成了我的《职工信息管理界面》练习：《借款工作簿查询维护版》。现发贴，请大家给予改进。附件太大，待设链接。

OKJSJSF · 发表于 2018-5-12 15:32

《借款工作簿查询维护版》链接：https://pan.baidu.com/s/1GNQrPuFsJFblfaw73-m2XQ 密码：eeg9
VBA工程密码：111111

OKJSJSF · 发表于 2018-5-14 17:32

有链接就是病毒吗？

OKJSJSF · 发表于 2018-6-10 12:50

没人为学生改作业。

OKJSJSF · 发表于 2018-8-17 20:07

贴子没人理太悲催，有错无法改。今天同事在使用过程中，保存合同信息（导入数据表）时出错，按CTRL+PAUSEBREAK不能退出程序，只能采用WINDOW管理器结束任务。我把工作簿重新发一下，不再用链接，直接上传附件：

OKJSJSF · 发表于 2018-8-17 20:10

本帖最后由 OKJSJSF 于 2018-8-19 08:51 编辑

以下是工作表信息导入数据表的代码：
Sub 合同信息导入(sh As Worksheet)
If Worksheets("借款申请公").Visible <> xlSheetVisible Then
      If Worksheets("测算表").[f2].Value <> "" And Worksheets("借款申请书").[c6].Value <> 0 Then
         Set mran2 = sh.Columns(21).Find(Worksheets("测算表").[f2].Value, lookat:=xlWhole)
      Else
         MsgBox "合同号或客户名未输录，不能保存！"
         Exit Sub
      End If
ElseIf Worksheets("借款申请书").Visible <> xlSheetVisible Then
      If Worksheets("测算表").[f2].Value <> "" And Worksheets("借款申请公").[c6].Value <> 0 Then
         Set mran2 = sh.Columns(21).Find(Worksheets("测算表").[f2].Value, lookat:=xlWhole)
      Else
         MsgBox "合同号或客户名未输录，不能保存！"
         Exit Sub
      End If
End If
If Not mran2 Is Nothing Then
      MsgBox "您正在执行:修改信息。"
      mrow = mran2.Row
Else
      MsgBox "您正在执行:新增信息。"
      mrow = 1 + sh.[a65536].End(xlUp).Row
      sh.Cells(mrow, 1).Value = mrow - 1
End If
Application.ScreenUpdating = False                                                                         以下代码把10张操作表数据导入1张数据表
Application.Interactive = False
If Worksheets("借款申请公").Visible <> xlSheetVisible Then
      With Worksheets("借款申请书")
         .Activate
         sh.Cells(mrow, 2).Value = .[c6].Value
         sh.Cells(mrow, 3).Value = .[i6].Value
         Dim val As String '抵押人三行保证人四行导入库第4列
         For Each mran In .[B17:B19,B23:B26]
            val = val & mran & "-"
         Next
         sh.Cells(mrow, 4).Value = val
         mcol = 5
         For Each mran In .[AE10:AF10,D11,AE12:AF12,ae16,AE32,B19,G17:G19,Q19]
            sh.Cells(mrow, mcol).Value = mran.Value
            mcol = 1 + mcol
         Next
      End With
      sh.Cells(mrow, 20).Value = Worksheets("对私自制申请").[g7].Value
ElseIf Worksheets("借款申请书").Visible <> xlSheetVisible Then
      With Worksheets("借款申请公")
         .Activate
         sh.Cells(mrow, 2).Value = .[c6].Value
         sh.Cells(mrow, 3).Value = .[c8].Value
         Dim arr4(0 To 3), i4 As Byte '抵押人二行保证人二行导入库第4列
         For Each mran In .[C15:C16,C19:C20]
            arr4(i4) = mran.Value
            i4 = i4 + 1
         Next
         sh.Cells(mrow, 4).Value = Join(arr4, "@")
         Erase arr4
         mcol = 5
         For Each mran In .[AA10:AB10,C11,AA12:AB12,aa14,AA26]
            sh.Cells(mrow, mcol).Value = mran.Value
            mcol = 1 + mcol
         Next
         sh.Cells(mrow, 17).Value = .[AA15].Value
         sh.Cells(mrow, 18).Value = .[c16].Value
         sh.Cells(mrow, 19).Value = .[c20].Value
      End With
      sh.Cells(mrow, 20).Value = Worksheets("对公自制申请").[g7].Value
End If
      With Worksheets("测算表")
         .Activate
         sh.Cells(mrow, 21).Value = .[f2].Value '合同号导入库第21列
         mcol = 22
         For Each mran In .[F4:F5,F7:F9,F11:F15,F18:F41,F43:F44,G39,H12,H47,F49,G51,J72:J77,I82:I89,K82:K85,N82:N85]
            sh.Cells(mrow, mcol).Value = mran.Value
            mcol = 1 + mcol
         Next
         sh.Cells(mrow, 85).Resize(1, 2).Value = .[g49:H49].Value '利率结果导入库第85\86列
      End With
      With Worksheets("调查报告")
         .Activate
         mcol = 87
         For Each mran In .[E5:E6,A12:A13,I21,A25,I31,A33,I39,I40:J40,A41,I42:I45,J42:J44,K43:K44,L44,I47]
            sh.Cells(mrow, mcol).Value = mran.Value
            mcol = 1 + mcol
         Next
      End With
If Worksheets("借款申请书").[ae16].Value = "抵押" Or Worksheets("借款申请公").[aa14].Value = "抵押" Then
      With Worksheets("抵押财产清单")
         .Activate
         Dim arr(0 To 35), i As Byte '土地合并导入库第110列
         For Each mran In .[B7:D7,G7:H7,J7,B8:D8,G8:H8,J8,B9:D9,G9:H9,J9,B10:D10,G10:H10,J10,B11:D11,G11:H11,J11,B12:D12,G12:H12,J12]
            arr(i) = mran.Value
            i = i + 1
         Next
         sh.Cells(mrow, 110).Value = Join(arr, "@")
         Erase arr
         Dim arr2(0 To 47), i2 As Byte '房屋合并导入库第111列
         For Each mran In .[B14:D14,G14:H14,J14,B15:D15,G15:H15,J15,B16:D16,G16:H16,J16,B17:D17,G17:H17,J17,B18:D18,G18:H18,J18,B19:D19,G19:H19,J19,B20:D20,G20:H20,J20,B21:D21,G21:H21,J21]
            arr2(i2) = mran.Value
            i2 = i2 + 1
         Next
         sh.Cells(mrow, 111).Value = Join(arr2, "@")
         Erase arr2
         sh.Cells(mrow, 112).Value = .[k32].Value
      End With
      With Worksheets("房地产价格评估表")
         .Activate
         mcol = 113
         For Each mran In .[d5,Y5,O6,F7,B11:B12,E11:E12,H11:H12,J10:J12,L10:L12,P10:P12,S10:S12,V10:V12,Y11:Y12,C21:C22,H21:H22,J21:J22,L20:L22, P20:P22, S20:S22, V21:V22, X21:X22, Z21:Z22]
            sh.Cells(mrow, mcol).Value = mran.Value
            mcol = 1 + mcol
         Next
      End With
      'if
      With Worksheets("房地产价格评估表2")
         .Activate
         For Each mran In .[d5,Y5,O6,F7,B11:B12,E11:E12,H11:H12,J10:J12,L10:L12,P10:P12,S10:S12,V10:V12,Y11:Y12,C21:C22,H21:H22,J21:J22,L20:L22, P20:P22, S20:S22, V21:V22, X21:X22, Z21:Z22]
            sh.Cells(mrow, mcol).Value = mran.Value
            mcol = 1 + mcol
         Next
      End With
      'end if
      With Worksheets("抵押品代管凭证")
         .Activate
         sh.Cells(mrow, 209).Value = .[d5].Value
         sh.Cells(mrow, 210).Resize(1, 5).Value = .[b7:f7].Value
      End With
End If
sh.Cells(1, 1).CurrentRegion.Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
Application.DisplayAlerts = False
      ThisWorkbook.Save
Application.DisplayAlerts = True
Application.Interactive = True
Call 二秒弹窗                                                                            导入完毕是应该用弹窗提醒一下的
With sh                                                                                  导入完毕还要用列表框展示一下最新的数据表数据的
      Dim mrow2 As Integer
      mrow2 = .[a65536].End(xlUp).Row
      UserForm7.ListBox1.ColumnWidths = "26,114,102,114"
      UserForm7.ListBox1.RowSource = "合同库!a2:hf" & mrow2
End With
End Sub

OKJSJSF · 发表于 2018-8-17 20:46

本帖最后由 OKJSJSF 于 2018-8-19 13:42 编辑

其中出错代码位置：
      With Worksheets("借款申请书")
         .Activate
         sh.Cells(mrow, 2).Value = .[c6].Value    '把操作表C6单元格的值导入数据表某行第2列单元格
         sh.Cells(mrow, 3).Value = .[i6].Value    '把操作表I6单元格的值导入数据表某行第3列单元格
         Dim val As String
         For Each mran In .[B17:B19,B23:B26]    '把操作表的7个单元格的值
            val = val & mran & " "    '串连成一个字符,保存在内存变量中,注意它没有使用分隔符,因为它以后不会被导出使用,不需被还原成原来的7个值
         Next             sh.Cells(mrow, 4).Value = val    '把上述字符串导入数据表某行第4列单元格.
         '因为我的程序中一张操作表导入数据表的数据个数超过一行极限275个,所以某些地方采用把操作表多个单元格的值串连后写入数据表的一个单元格,使用的时候还原为原来的多个值.
         mcol = 5
         For Each mran In .[AE10:AF10,D11,AE12:AF12,ae16,AE32,B19,G17:G19,Q19]    '把操作表的12个单元格的值
            sh.Cells(mrow, mcol).Value = mran.Value    '导入数据表某行第5至16列单元格
            mcol = 1 + mcol
         Next
      End With
上面黄色代码在执行中出错,在中断模式：光标移到变量mrow，显示mrow=2，即数据表第2行，正确的；
光标移到变量mcol，显示mcol=11，即变量从5开始执行到第7次时累加到11，说明操作表的AE32单元格数据导入数据表第11列时出错，程序停止；
光标移到变量mran，显示 mran.value =<"溢出">，不知这是什么错?特求助。
mrow\mcol\mran都是模块级变量.mran类型为range

OKJSJSF · 发表于 2018-8-17 20:49

本帖最后由 OKJSJSF 于 2018-8-19 13:41 编辑

我的借款工作簿：

借款工作簿 - 副本.rar (1.64 MB, 下载次数: 8) 程序参照《别怕，Excel VBA其实很简单》第280页：职工信息管理界面。二者区别是：一、我的是多张操作表数据导入多张数据表。后者是1张操作表数据导入1张数据表。二、由于我的数据量大，在数据导入导出过程中采用在多重选定区域中循环取数的方法，减少代码行数。后者因为是教材场景，数据量少，在数据导入导出过程中采用逐个取数逐个写代码的方法。三、我的不同操作表运行相同的过程时采用参数的方法减少代码量。四、我的查找匹配采用模糊方法，并把高级筛选也作为一种查找方法。五、我的因为是模糊匹配与高级筛选查找，所以增加了一个过渡表，用列表框展示数据，在列表框中选择确定唯一查找值。六、我的增加大量消息框作提醒。七、我的在工作簿同位置增加图片文件供操作表显示。

OKJSJSF · 发表于 2018-8-17 20:55

因为同事在使用我的上面的程序(借款工作簿)中,在保存数据时出错,按CTRL+PAUSEBREAK无法退出程序,自己未查到原因,特求助.

OKJSJSF · 发表于 2018-8-19 13:46

mran.value =<"溢出"> 这可能是什么错？紧急求助！紧急求助！！！

		自动登录	找回密码
密码			免费注册

[求助] 至关重要的Range对象，我的核心！