按指定内容填填入指定单元格

小NN

求助各位


需求：
用数据库表单中A列中的数据遍历整个工作簿中所有工作表，每个工作表中的数据可能存在于固定的三个位置，没有重复数据，找到一致的数据后，取数据库表单中数据对应B列中的数值去填入，填入到相应有黑框的格子（黑框只为了表示，实际不一定有黑框）。
每个工作表其它位置还有数据，只判断，并填入黑框位置，不能修改其它单元格数据。

gwjkkkkk

Option Explicit
Sub TEST()
    Dim ar, br, i&, j&, dic As Object, wks As Worksheet
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = Sheets(1).[A1].CurrentRegion
    For i = 1 To UBound(ar): dic(ar(i, 1)) = ar(i, 2): Next
    br = Array(3, 5, 7)
   
    For Each wks In Sheets
        If wks.Name <> "数据库" Then
            With wks
                For j = 0 To UBound(br)
                    .Cells(10, br(j)) = dic(.Cells(6, br(j)).Value)
                Next j
            End With
        End If
    Next
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

zxsea_7426

是不是各表中根据对应于C6\\E6\\G6值用数据库表中的值写入对应的C10\\E10\\G10??

gwjkkkkk

请参考附件。。。

小NN

zxsea_7426 发表于 2023-3-11 17:01
是不是各表中根据对应于C6\\E6\\G6值用数据库表中的值写入对应的C10\\E10\\G10??

是的，遍历所有工作表，找到与数据库匹配的数据，然后填入对应数值。压缩文件有描述。

zxsea_7426

小NN 发表于 2023-3-11 19:46
是的，遍历所有工作表，找到与数据库匹配的数据，然后填入对应数值。压缩文件有描述。

二楼已经有代码了。我问的就是这个意思

小NN

gwjkkkkk 发表于 2023-3-11 16:52
Option Explicit
Sub TEST()
    Dim ar, br, i&, j&, dic As Object, wks As Worksheet

大神，再问下，能不能改完之后再给那个单元格涂个颜色？

gwjkkkkk

小NN 发表于 2023-3-11 20:08
大神，再问下，能不能改完之后再给那个单元格涂个颜色？

请参考。。。