Sub 不同工作簿间提取信息() '用于单个字段信息的提取;
Dim w As Workbook, wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet, ce As Range, shp As Shape
Dim dic As Object, re As Object
Dim arr, brr, crr '若带()则默认为一维数组;
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
' Set wb1 = ActiveWorkbook
' Set sh = ActiveSheet
关键词A = "教师信息"
关键词B = "学生信息"
关键词C = "中期检查"

m = 0
For Each w In Workbooks
If InStr(w.Name, 关键词A) > 0 Then
Set wb1 = Workbooks(w.Name)
m = m + 1
ElseIf InStr(w.Name, 关键词B) > 0 Then
Set wb2 = Workbooks(w.Name)
m = m + 1
ElseIf InStr(w.Name, 关键词C) > 0 Then
Set wb3 = Workbooks(w.Name)
m = m + 1
End If
If m = 3 Then Exit For 'm还可设置3或更多;
Next
Set sh1 = wb1.Sheets(1)
For i = 2 To wb1.Sheets(1).Range("D65536").End(3).Row '对应关键词A
If Not dic1.exists(Trim(sh1.Range("C" & i).Value)) Then dic1.Add Trim(sh1.Range("C" & i).Value), Trim(sh1.Range("D" & i).Value)
Next
Set sh2 = wb2.Sheets(1)
For i = 2 To sh2.Range("H65536").End(3).Row '对应关键词B
sh2.Range("J" & i).Value = dic1(Trim(sh2.Range("H" & i).Value))
Next

MsgBox "已完成!!!", vbOKCancel, "程序处理"

End Sub

Sub 多字段工作簿间提取信息() '利用数组来实现赋值;
Dim w As Workbook, wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet, ce As Range, shp As Shape
Dim dic As Object, re As Object
Dim arr, brr, crr '若带()则默认为一维数组;
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
' Set wb1 = ActiveWorkbook
' Set sh = ActiveSheet
关键词A = "姓名汇总"
关键词B = "学生信息"
关键词C = "中期检查"

m = 0
For Each w In Workbooks
If InStr(w.Name, 关键词A) > 0 Then
Set wb1 = Workbooks(w.Name)
m = m + 1
ElseIf InStr(w.Name, 关键词B) > 0 Then
Set wb2 = Workbooks(w.Name)
m = m + 1
ElseIf InStr(w.Name, 关键词C) > 0 Then
Set wb3 = Workbooks(w.Name)
m = m + 1
End If
If m = 3 Then Exit For 'm还可设置3或更多;
Next
Set sh1 = wb1.Sheets(1)
arr = sh1.UsedRange
For i = 2 To wb1.Sheets(1).Range("B65536").End(3).Row '对应关键词A
If Not dic1.exists(Trim(arr(i, 2))) Then dic1.Add Trim(arr(i, 2)), i '行号
'If Not dic1.exists(Trim(sh1.Range("B" & i).Value)) Then dic1.Add Trim(sh1.Range("B" & i).Value), sh1.Range("D" & i).Row '行号
Next
Set sh2 = wb2.Sheets(1)
For i = 2 To sh2.Range("H65536").End(3).Row '对应关键词B
ro = dic1(Trim(sh2.Range("D" & i).Value))
If sh2.Range("C" & i).Value = "" Then
sh2.Range("C" & i).Value = arr(ro, 1) '这里也容易出错,不使用Value会导致出问题;无法赋值;
ElseIf CStr(sh2.Range("C" & i).Value) <> CStr(arr(ro, 1)) Then '这里就容易出问题。不用Cstr会导致字符串和数字不等;
MsgBox "错误!!!" & arr(ro, 2) & "学号不匹配!!!"
End If
sh2.Range("i" & i).Value = arr(ro, 3)
Next

MsgBox "已完成!!!", vbOKCancel, "程序处理"

End Sub

Excel不同工作簿之间提取信息的更多相关文章

  1. 我们无法找到服务器加载工作簿的数据模型"的 SharePoint 网站,当您刷新 Excel 2013 工作簿中的数据透视表时出错

    假定您使用 Analysis Services 源在 Microsoft Excel 2013 中创建数据透视表.将 Excel 工作簿上载到 Microsoft SharePoint 网站中.当您尝 ...

  2. VB6实现Excel多工作簿数据合并

    以前的同事,工作需要,让我帮忙完成多个工作簿的汇总. 我就用最熟悉的VB6写了一个Form应用程序,这是因为我不知道她目前的系统和Office情况,如果太高大上了,她不会部署安装.索性就简单粗暴地来个 ...

  3. excel破解工作簿与工作表保护

    1.工作簿保护 1.1.使用压缩文件打开文件

  4. Excel统计工作簿sheet个数

    按Alt+F11调出VBE后,在"视图"-“立即窗口”中输入: debug.print ThisWorkbook.Sheets.Count 回车后就可看到工作表数量.

  5. 把Excel工作簿的每个工作表提取出来保存为新工作簿

    平台:MS office 2010 任务:有个excel工作簿,其中有上百个工作表,要求把每一个工作表全部保存为新工作簿,如果一个一个复制出来太傻了,可以用excel自带的VB解决. 方法:打开工作簿 ...

  6. 在excel单元格中提取信息

    平时在excel中处理数据的时候,肯定会遇到在单元格提取信息的情况,比如在地址中提取省.市.地区等,如果数据源内容规整的话,可以直接使用left().right().mid()等函数直接提取,但是大多 ...

  7. C# Aspose.Cells导出xlsx格式Excel,打开文件报“Excel 已完成文件级验证和修复。此工作簿的某些部分可能已被修复或丢弃”

    报错信息: 最近打开下载的 Excel,会报如下错误.(xls 格式不受影响) 解决方案: 下载代码(红色为新添代码) public void download() { string fileName ...

  8. 如何使用 Visual C# 2005 或 Visual C# .NET 向 Excel 工作簿传输数据

    本文分步介绍了多种从 Microsoft Visual C# 2005 或 Microsoft Visual C# .NET 程序向 Microsoft Excel 2002 传输数据的方法.本文还提 ...

  9. Excel提示“此工作簿包含一个或多个无法更新的链接”怎么办

    有时打开Excel文件时会弹出一个“此工作簿包含一个或多个无法更新的链接”的提示.对于初次接触这个提示的用户,可能会感到迷惑,不知道应该如何处理,这里以Excel2007为例,介绍一下这个提示出现的原 ...

随机推荐

  1. Upgrade Bash on Ubuntu from 14.04 to 16.04

    过程 1 sudo -S apt-mark hold sudo sudo -S apt-mark hold procps sudo -S apt-mark hold strace 2 sudo do- ...

  2. C# ASP.NET 验证码

    使用C# ASP.NET 获取 验证码的代码书写 一般都采用异步 点击 前台验证码图片 请求一次 : 前台图片代码: <img id="imgvalidatecode" sr ...

  3. AS3帮助手册

    http://help.adobe.com/zh_CN/FlashPlatform/reference/actionscript/3/index.html

  4. 微信红包算法TEST

    1.基本算法 设定总金额为10元,有N个人随机领取:N=1 则红包金额=X元: N=2 为保证第二个红包可以正常发出,第一个红包金额=0.01至9.99之间的某个随机数 第二个红包=10-第一个红包金 ...

  5. (转)MapReduce Design Patterns(chapter 6 (part 1))(十一)

    Chapter 6. Metapatterns 这种模式不是解决某个问题的,而是处理模式的关系的.可以理解为“模式的模式”.首先讨论的是job链,把几个模式联合起来解决复杂的,有多个阶段要处理的问题. ...

  6. ss-libev 源码解析udp篇 (2)

    UDP relay的代码基本都在udprelay.c中,无论ss-local还是ss-server的代码都在一起,使用宏MODULE_LOCAL,MODULE_REMOTE等区分开.代码虽然不是很多, ...

  7. 余弦相似度及基于python的三种代码实现、与欧氏距离的区别

    1.余弦相似度可用来计算两个向量的相似程度 对于如何计算两个向量的相似程度问题,可以把这它们想象成空间中的两条线段,都是从原点([0, 0, ...])出发,指向不同的方向.两条线段之间形成一个夹角, ...

  8. Android Studio真机测试失败-----''No target device found" (转)

    参考文章: https://blog.csdn.net/chang_sir/article/details/51755572 今天想用真机测试一个程序,却报出这样一个Error"No tar ...

  9. vim让一些不可见的字符显示出来吧

    http://www.cnblogs.com/chenwenbiao/archive/2011/10/26/2225467.html :set list

  10. [转]MongoDB c++驱动安装与使用

    安装 获取源码:git clone https://github.com/mongodb/mongo-cxx-driver.git,解压 安装编译工具scons:yum install -y scon ...