系列文章目录
文章目录
- 系列文章目录
- 一、目标需求
- 二、使用步骤
- 1.VBA程序
- 2.VBA简要程序
- 总结
一、目标需求
工作表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
总结
分享：
接受可以让我面对所有的问题，当我感到焦虑的时候，通常是因为我发现自己不能接受生活中的一些人、地方、事情，直到我完全接受了它们，我才能获得心灵上的安宁。除非我完全的接受生活，否则我将无法获得快乐。我不需要再纠结这个世界上有什么需要改变而是关注我自己的态度需要发生怎样的改变；
