系列文章目录

一、目标需求

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

二、使用步骤

1.VBA程序

代码如下（示例）：

Sub ExtractData()Dim ws1 As Worksheet, ws2 As WorksheetDim rng1 As Range, rng2, rng3, rng4, sourceCell, destinationCell As Range, cell As RangeDim i, j As IntegerDim charColor As LongDim sourceValue As StringDim charIndex As IntegerDim formattedText As StringDim fontColors() As LongDim colorIndex As IntegerDim color As Integer'设置工作表1和工作表2Set 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 = xlNonerng3.Font.colorIndex = xlNonerng3.Font.colorIndex = xlAutomatic'遍历工作表1的每个单元格For Each cell In rng1If 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.RowSet sourceCell = ws2.Cells(matchcell.Row, "AK")Set destinationCell = ws1.Cells(cell.Row, "F")Set targetCell = ws1.Cells(cell.Row, "F")destinationCell.value = ""'Text = sourceCell.valueSet rngSource = ws2.Range("AK" & a)ReDim fontColors(0 To rngSource.Characters.Count)For j = 1 To sourceCell.Characters.CountcharColor = sourceCell.Characters(j, 1).Font.colorfontColors(j) = charColorNext jFor j = 1 To sourceCell.Characters.CountWith destinationCell.Characters(j, 1).Fontcolor = fontColors(j)End WithNext jws2.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 IfEnd IfNext cell
End Sub

2.VBA简要程序

Sub ExtractData()Dim ws1 As Worksheet, ws2 As WorksheetDim rng1 As Range, rng2, rng3, rng4, sourceCell, destinationCell As Range, cell As RangeDim i, j As IntegerDim charColor As LongDim sourceValue As StringDim charIndex As IntegerDim formattedText As StringDim fontColors() As LongDim colorIndex As IntegerDim color As Integer'设置工作表1和工作表2Set 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 = xlNonerng3.Font.colorIndex = xlNonerng3.Font.colorIndex = xlAutomatic'遍历工作表1的每个单元格For Each cell In rng1If 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.RowSet 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.CountcharColor = sourceCell.Characters(j, 1).Font.colorfontColors(j) = charColorNext jFor j = 1 To sourceCell.Characters.CountWith destinationCell.Characters(j, 1).Fontcolor = fontColors(j)End WithNext jws2.Range("AK" & a).Copy Destination:=ws1.Cells(cell.Row, "F")End IfEnd IfNext cell
End Sub

总结

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