求助修改输入数字后匹配B表R列后填充N列内容和P列格式的代码

百读谷歌

求助大佬，原本代码是输入数字后匹配B表R列后填充N列内容的，


现在我想填充N列内容同时也把B表的P列的的格式复制过来到输入单元格对应的E列位置。（注意只是复制格式，内容不要复制）


我尝试过修改代码，但是复制格式这里始终没反应。

求助大佬给看看，怎么添加下代码实现这个需求？感谢！！

原代码


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ar, i&, dic As Object
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 2 And Target.Row > 1 Then
        Set dic = CreateObject("Scripting.Dictionary")
        Application.EnableEvents = False
        With Sheets(2)
            ar = .Range("N1", .Cells(Rows.Count, "R").End(xlUp))
            For i = 2 To UBound(ar)
                If Len(ar(i, 5)) Then dic(ar(i, 5)) = ar(i, 1)
            Next i
            If dic.exists(Target.Value) Then Target.Value = dic(Target.Value)
        End With
        Application.EnableEvents = True
    End If
End Sub

ykcbf1100

先把B表的P列格式先复制到A表的E列就行了吧

chxw68

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim ar, i&, dic As Object
   
3.     If Target.Count > 1 Then Exit Sub
   
4.     If Target.Column = 2 And Target.Row > 1 Then
   
5.         Application.EnableEvents = False
   
6.         With Worksheets("B表")
   
7.             r = .Cells(.Rows.Count, 14).End(xlUp).Row
   
8.             For i = 2 To r
   
9.                 If .Cells(i, 18) = Target.Value Then
   
10.                     Target.Value = .Cells(i, 14)
    
11.                     Target.Offset(0, 2).NumberFormatLocal = .Cells(i, 16).NumberFormatLocal
    
12.                     Exit For
    
13.                 End If
    
14.             Next
    
15.         End With
    
16.         Application.EnableEvents = True
    
17.     End If
    
18. End Sub
    

复制代码

chxw68

修改好了。

百读谷歌

chxw68 发表于 2024-9-11 15:14
修改好了。

感谢大神，一下字解决了。

然后我想请问一下，现在是把P列的的格式复制过来到输入单元格对应的E列位置。

如果我想把对应P列单元格的格式同步过来要修改哪里可以实现？（就是包括数字自定义格式和字体大小，居中位置这些）

chxw68

修改好了。

百读谷歌

chxw68 发表于 2024-9-11 16:50
修改好了。

非常感谢，完美！！