vba学习系列(4)-- index()提取指定单元格并保留字体格式

最新推荐文章于 2024-05-23 20:15:19 发布
最新推荐文章于 2024-05-23 20:15:19 发布
阅读量579 收藏 5
点赞数 2
分类专栏： 学习 VBA 文章标签： 学习
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/qq_45365214/article/details/122481569
版权
学习 同时被 2 个专栏收录
37 篇文章 5 订阅
订阅专栏
VBA
16 篇文章 6 订阅
订阅专栏
文章详细描述了如何通过VBA编写程序，在Excel中当工作表1C列与工作表2B列中的姓名匹配时，从工作表2AK列提取对应数据，并保持源数据的字体颜色和格式一致。
摘要由CSDN通过智能技术生成

系列文章目录

文章目录

一、目标需求

工作表2 B列中姓名，在工作表1 C列中存在相同姓名时，提取工作表2 AK列的对应单元格内容；
工作表2名称：OQC
工作表1名称：汇总

二、使用步骤

1.VBA程序

代码如下（示例）：


Sub ExtractData()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2, rng3, rng4, sourceCell, destinationCell As Range, cell As Range
    Dim i, j As Integer
    Dim charColor As Long
    Dim sourceValue As String
    Dim charIndex As Integer
    Dim formattedText As String
    Dim fontColors() As Long
    Dim colorIndex As Integer
    Dim color As Integer

    
    '设置工作表1和工作表2
    Set ws1 = ThisWorkbook.Sheets("汇总")
    Set ws2 = ThisWorkbook.Sheets("OQC")
    '设置范围对象
    Set rng1 = ws1.Range("C:C")
    Set rng2 = ws2.Range("B:B")
    Set rng3 = ws1.Range("F3:F100")
    Set rng4 = ws2.Range("AK2:AK100")
    
    rng3.Interior.colorIndex = xlNone
    rng3.Font.colorIndex = xlNone
    rng3.Font.colorIndex = xlAutomatic
    
    '遍历工作表1的每个单元格
    For Each cell In rng1
        If cell.value <> "" Then
            '在工作表2的B列查找匹配项
            Set matchcell = rng2.Find(What:=cell.value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not matchcell Is Nothing Then
            '如果找到匹配项，则提取工作表2对应的AK列数据
                a = matchcell.Row
                Set sourceCell = ws2.Cells(matchcell.Row, "AK")
                Set destinationCell = ws1.Cells(cell.Row, "F")
                Set targetCell = ws1.Cells(cell.Row, "F")
                destinationCell.value = ""
                
                'Text = sourceCell.value
                Set rngSource = ws2.Range("AK" & a)
                
                ReDim fontColors(0 To rngSource.Characters.Count)
                For j = 1 To sourceCell.Characters.Count
                    charColor = sourceCell.Characters(j, 1).Font.color
                    fontColors(j) = charColor
                Next j
                
                For j = 1 To sourceCell.Characters.Count
                    With destinationCell.Characters(j, 1).Font
                        color = fontColors(j)
                    End With
                Next j
                
                ws2.Range("AK" & a).Copy Destination:=ws1.Cells(cell.Row, "F")                    
                                               
                '定义要使用的颜色数组
                'Colors = Array(vbRed, vbBlue, vbGreen)
                
                'For i = 1 To sourceCell.Characters.Count
                    'Set charFormat = sourceCell.Characters(Start:=i, Length:=1).Font
                    'targetCell.Characters(Start:=i, Length:=1).Font.color = charFormat.color
                    'targetCell.Characters(Start:=i, Length:=1).Font.Bold = charFormat.Bold
                     ' 如果需要复制其他字体属性，比如Italic或Underline，可以继续添加代码行
                'Next i                                    
                
                'ReDim fontColors(1 To sourceCell.Characters.Count)
                'ReDim fontColors(2 To rngSource.Characters.Count)
                
                'destinationCell.value = sourceCell.value
                'sourceCell.Copy Destination:=destinationCell
                
                'destinationCell.Interior.color = sourceCell.Interior.color
                'destinationCell.Font.color = sourceCell.Font.color                                
            
               'ws1.Cells(cell.Row, "F").value = ws2.Cells(matchcell.Row, "AK").value
               'ws1.Cells(Cell.Row, "F").Font.Color = ws2.Cells(matchCell.Row, "AK").Font.Color
               'ws1.Cells(Cell.Row, "F").Font.ColorIndex = ws2.Cells(matchCell.Row, "AK").Font.ColorIndex
               'ws1.Cells(Cell.Row, "F").Interior.Color = ws2.Cells(matchCell.Row, "AK").Interior.Color
               'ws1.Cells(Cell.Row, "F").Interior.ColorIndex = ws2.Cells(matchCell.Row, "AK").Interior.ColorIndex
               
               'ws1.Cells(Cell.Row, "F").HorizontalAlignment = ws2.Cells(matchCell.Row, "AK").HorizontalAlignment
               'ws1.Cells(Cell.Row, "F").VerticalAlignment = ws2.Cells(matchCell.Row, "AK").VerticalAlignment
               'ws1.Cells(Cell.Row, "F").Borders.LineStyle = ws2.Cells(matchCell.Row, "AK").Borders.LineStyle
               'ws1.Cells(Cell.Row, "F").Borders.Color = ws2.Cells(matchCell.Row, "AK").Borders.Color
                                         
               'ws1.Cells(Cell.Row, "F").Font.Name = ws2.Cells(matchCell.Row, "AK").Font.Name
               'ws1.Cells(Cell.Row, "F").Font.Size = ws2.Cells(matchCell.Row, "AK").Font.Size
               'ws1.Cells(Cell.Row, "F").Font.Bold = ws2.Cells(matchCell.Row, "AK").Font.Bold
               'ws1.Cells(Cell.Row, "F").Font.Italic = ws2.Cells(matchCell.Row, "AK").Font.Italic                        
          
            End If
        End If
    Next cell
End Sub

2.VBA简要程序


Sub ExtractData()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2, rng3, rng4, sourceCell, destinationCell As Range, cell As Range
    Dim i, j As Integer
    Dim charColor As Long
    Dim sourceValue As String
    Dim charIndex As Integer
    Dim formattedText As String
    Dim fontColors() As Long
    Dim colorIndex As Integer
    Dim color As Integer

    
    '设置工作表1和工作表2
    Set ws1 = ThisWorkbook.Sheets("汇总")
    Set ws2 = ThisWorkbook.Sheets("OQC3")
    '设置范围对象
    Set rng1 = ws1.Range("C:C")
    Set rng2 = ws2.Range("B:B")
    Set rng3 = ws1.Range("F3:F100")
    Set rng4 = ws2.Range("AK2:AK100")
    
    rng3.Interior.colorIndex = xlNone
    rng3.Font.colorIndex = xlNone
    rng3.Font.colorIndex = xlAutomatic
    
    '遍历工作表1的每个单元格
    For Each cell In rng1
        If cell.value <> "" Then
            '在工作表2的B列查找匹配项
            Set matchcell = rng2.Find(What:=cell.value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not matchcell Is Nothing Then
            '如果找到匹配项，则提取工作表2对应的AK列数据
                a = matchcell.Row
                Set sourceCell = ws2.Cells(matchcell.Row, "AK")
                Set destinationCell = ws1.Cells(cell.Row, "F")
                Set targetCell = ws1.Cells(cell.Row, "F")
                destinationCell.value = ""
                
                Set rngSource = ws2.Range("AK" & a)
                
                ReDim fontColors(0 To rngSource.Characters.Count)
                For j = 1 To sourceCell.Characters.Count
                    charColor = sourceCell.Characters(j, 1).Font.color
                    fontColors(j) = charColor
                Next j
                
                For j = 1 To sourceCell.Characters.Count
                    With destinationCell.Characters(j, 1).Font
                        color = fontColors(j)
                    End With
                Next j
                
                ws2.Range("AK" & a).Copy Destination:=ws1.Cells(cell.Row, "F")
                                                
            End If
        End If
    Next cell
End Sub

总结

分享：
接受可以让我面对所有的问题，当我感到焦虑的时候，通常是因为我发现自己不能接受生活中的一些人、地方、事情，直到我完全接受了它们，我才能获得心灵上的安宁。除非我完全的接受生活，否则我将无法获得快乐。我不需要再纠结这个世界上有什么需要改变而是关注我自己的态度需要发生怎样的改变；

若竹之心
关注
  • 2
    点赞
  • 踩
  • 5
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
专栏目录
VBA编写函数来提取指定单元格的批注
qq_52695698的博客
06-25 309
4. 在需要提取批注的单元格旁边，输入公式“=GetComment(目标单元格引用)”，例如“=GetComment(A1)”。1. 打开Excel，按下Alt + F11键进入VBA编辑器。5. 按下Enter键，即可看到目标单元格批注的内容被提取出来。3. 关闭VBA编辑器并返回Excel界面。
VBA:application.index 函数的用法
pgymeitianjinbu的博客
03-21 3104
例：把A2:D6的第一列写入arr1，第四行写入arr2。调用该工作表函数可以把二维数组的某一列或某一行截取出来，第一部分：先看下excel中index的用法。备注：后续有需要，我会再补充进来。
VBA 关于数组的index ：index的个数， index的初值，index的上下限，index序列
奔跑的犀牛先生
01-14 8594
1 数组的不同定义方式，会导致 index的起点不同 总结，简单的说，就是VBA里的数值，index默认从0 开始，而从工作表来源的函数，默认index从1开始 用VBA的数值array() 或者 dim 或者 redim 这几种方法，默认index从0开始 当然 dim 或者 redim 可以声明从1开始或从其他开始 而从工作表区域赋来的数组，无论是1维还是2维，index都从1开始 [{}] 这种赋值方式，我认为是偏工作表的， 因为 [a1:b5] 就等同于 range("a1;b...
【EXCEL_VBA_常用过程 & 函数】
最新发布
分享个人收获，创建共享共赢社区
05-23 516
结合日常工作需要，收录或改写相关过程及函数，现共享给大家，希望能对大家有所帮助！
VBA index(AryOrg, AryXrow, AryYcol,AryFilter)的理解
qq_26244463的博客
01-23 1176
Row数组应为 二维1列; Column数组应为 二维1行, 才可得到所需要的数组区域, 返回为二维数组. 以下 单个格子代表 数字 或 一维数组的元素, 横向连接在一起的单元格代表 二维一行数组; 竖向连接在一起的单元格代表 二维单列数组; ...
运用Excel VBA在EXcel中实现的提取单元格中特定文字
09-25
这是我个人运用Excel VBA在EXcel中实现的提取单元格中特定文字，并用”.“来标注此单元格是否存在这个字符的小程序。
【excel VBA】 动态显示运行结果 （BY：index 函数）
神创的博客
03-15 2586
参考：http://office.jb51.net/excel/6799.html    https://jingyan.baidu.com/article/2a1383284d20e2074a134fa0.html    https://jingyan.baidu.com/article/5553fa82926c9665a239348a.html    http://www.exceltip.n...
VB Index
Hannah
01-12 1398
花了一天时间做了一个vb目录，做目录的目的： 1、初学者可以大致了解vb课程，对章节和基本内容有所印象。 2、已经学过的同学则可以通过目录对整本书的内容进行回忆，检查出疏忽的知识点并强化已掌握的知识。 以下是我所做目录的部分截图，有需要的同学可以找我哦，呵呵
VBA中的图表操作：将提取的数据可视化呈现
# 1. **介绍VBA中的图表操作** ... VBA广泛应用于Excel中，可以实现诸如数据提取、处理、分析、可视化等一系列操作。通过VBA，用户可以编写脚本来自动化复杂的任务，提高工作效率。 ## 1.3 图表在数据可视化
Excel学习资料（配套练习题素材）.rar
11-21
1. 单元格操作：了解如何选择、编辑、格式化单元格，包括设置字体、颜色、边框和对齐方式。 2. 公式与函数：学习如何输入公式，理解相对引用、绝对引用和混合引用的区别，以及掌握常用的数学、统计和逻辑函数，如SUM...
【学习笔记】EXCEL数据处理--规范与方法
weixin_46496223的博客
05-11 1595
目录1、表格设计的规范要求2、单元格的规范要求3、防止不过范发生4、数据预处理 1、表格设计的规范要求 EXCEL常用表格类型：清单表、功能表、报表 数据处理阶段使用的是清单表。 需注意的点： 不要合并单元格（筛选、排序、透视等都会出现错误） 不要多余行和列（例如空隔、汇总信息等） 不要多行表头 数据格式要统一 避免空值（尽量避免） 避免二维表（即某字段在列上展开） ...
excel-vb常用词汇252个
10-08
数组常用于存储一系列相似类型的数据，并可通过索引来访问这些数据。 #### As 作为 `As`关键字用于声明变量时指定其数据类型，例如`Dim x As Integer`表示声明了一个整型变量x。 #### Autoredraws 自动重画 `...
EXCEL&VBA: 中国热力图 HeatMap of China
热门推荐
岁月催猪老
11-27 2万+
事先声明以下内容基本全部是学习大神刘万祥的热力型数据地图(HeatMap)做法详解做成的，基本算是一个学习笔记。其中我也添加了一些个人的见解和改进。 （做这个热力图是给公司用的，其它是回家整理的，所以附件是英文，截图的excel是中文，有点混乱，但是不妨碍理解。）
excel中VBA获取指定单元格内容
u010719791的专栏
11-24 1万+
1、筛选指定列获取数据 For Each Rng In Sheets("目录").Range("b1:B23") Debug.Print Rng.Value If Rng.Value = "个人" Then n = n + 1 Sheets("备注").Cells(n, "g").Resize(1, 5) = Rng.Offset(0, -1).Range("a1:e1").Value Sheets("备注").Cells(n, "g").
利用VBA实现：提取Excel单元格数字
weixin_44596571的博客
04-14 2928
利用VBA处理excel提取单元格数字，附带程序！
Vb中Index的用法
快乐学习
12-26 1万+
函数INDEX()有两种形式：数组和引用。数组形式通常返回数值或数值数组；引用形式通常返回引用。 语法： INDEX(array，row_num，column_num)返回数组中指定的单元格或单元格数组的数值。 INDEX(reference，row_num，column_num，area_num)返回引用中指定单元格或单元格区域的引用。 参数： Array为单元格区域或数组常数；R
vba怎样读取选定单元格内容_使用VBA读取指定Excel文件指定Sheet指定单元格的内容...
weixin_40002224的博客
01-30 3332
打开一个Excel文件，选择菜单栏上的"Tools"选项->Macro->Visual Basic Editor，打开VBA编辑器。在Modules文件夹下的csMain文件中，写下如下VB格式的代码：Public Sub Source做成()'声明Excel相关Dim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookSet ...
VBA，如何查找一个数组内，某个元素的index，和序号（从1开始 ）是多少？以及报错处理
奔跑的犀牛先生
12-20 1万+
如何查找一个数组内，某个元素的index是多少？ 如果element元素唯一，可以用match查， 但是 application.match 比 worksheetfunction.match() 函数更健壮 如果不唯一呢 用match 只能返回第一个查到的元素的index 注意 match() 查找 5 和 "5" 都不一样 Application.Match...
拷贝合并单元格时保留格式
神奇的BI
05-08 663
Excel中的合并单元格是个很奇葩的功能，有的用户非常喜欢这个功能，但是合并单元格的功能有时差强人意，处理起来非常麻烦，从数据处理的角度考虑，不推荐使用合并单元格。 既然Excel提供了合并单元格功能，那么用户就可能会使用这个功能，例如A1:B4为合并单元格区域，其中的文字内容具有不同的格式，现在需要将其内容和格式拷贝到D1单元格，目标区域也是一个合并单元格区域，使用Excel的拷贝与粘贴，只能把文字拷贝过去，字体格式丢失了，如下图所示。 Sub CopyMerge(srcCel As Range, de
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

若竹之心

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付：¥1
获取中
扫码支付

您的余额不足，请更换扫码支付或充值

打赏作者

实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值