请高手用VBA帮我完成表格中的内容

15724706808

表1为模板，表2是粘贴过来的数据，然后点运行，对应的后面几列就会等于表2数据

abc123281

Sub test()
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet2")
  arr = .UsedRange
  For i = 2 To UBound(arr)
    d(arr(i, 2)) = Array(arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7))
  Next
End With
With Worksheets("sheet1")
.UsedRange.Offset(2, 3).ClearContents
  r = .Cells(Rows.Count, 2).End(xlUp).Row
  For Each Rng In .Range("b3:b" & r)
    Rng.Offset(0, 2).Resize(1, 4) = d(Rng.Value)
  Next
End With
End Sub

abc123281

abc123.rar (19.02 KB, 下载次数: 20)

2018-9-29 19:58 上传

点击文件名下载附件

仲夏之雪

Sub 粘贴程序()

Dim i, j, n As Integer

For i = 2 To Worksheets("Sheet2").UsedRange.Rows.Count Step 1
    For j = 2 To Worksheets("Sheet1").UsedRange.Rows.Count Step 1
        If Worksheets("Sheet2").Range("B" & i) = Worksheets("Sheet1").Range("B" & j) Then
            Worksheets("Sheet1").Range("D" & j) = Worksheets("Sheet2").Range("D" & i)
            Worksheets("Sheet1").Range("E" & j) = Worksheets("Sheet2").Range("E" & i)
            Worksheets("Sheet1").Range("F" & j) = Worksheets("Sheet2").Range("F" & i)
            Worksheets("Sheet1").Range("G" & j) = Worksheets("Sheet2").Range("G" & i)
        End If
    Next j
Next i

End Sub

15724706808

---------------

15724706808

abc123281 发表于 2018-9-29 19:58

谢谢大神，还有个问题，这个表一复制过来的字体颜色怎么等于表二所在单元格的颜色

15724706808

仲夏之雪 发表于 2018-9-30 14:09
Sub 粘贴程序()

Dim i, j, n As Integer

谢谢大神，还有个问题，这个表一复制过来的字体颜色怎么等于表二所在单元格的颜色