用VBA实现根据单元格内容自动填写sheet2中对应的数据

罗亮亮

各位师傅好,想知道用VBA实现根据单元格内容自动填写sheet2中对应的数据,因为我要自动填写完后要修改备注栏内一些内容我也在论坛里面找了好多例子 但是都实现不了 有的帖子都是2009年的  到现在都用不了 想请高手帮忙  在这里谢谢了
请求帮助 再次感激 求助如何根据单元格内容自动填写对应的数据.zip (14.68 KB, 下载次数: 29)

2020-1-29 12:39 上传

点击文件名下载附件

shenjianrong163

可以用函数实现，在D2中输入以下函数：
=VLOOKUP(C2,数据!C:D,2,0)

罗亮亮

shenjianrong163 发表于 2020-1-29 13:06
可以用函数实现，在D2中输入以下函数：
=VLOOKUP(C2,数据!C:D,2,0)

谢谢老师,特别想用vba实现 想要随时修改备注内容的

orr89

Private Sub Worksheet_Change(ByVal T As Range)
    If T.Row = 2 And T.Column = 3 Then
        chazhao = [c2].Value
        arr = Sheet2.Range("c2:d" & Sheet2.[c60000].End(xlUp).Row)
        For a = 1 To UBound(arr)
            If arr(a, 1) = chazhao Then Sheet1.[d2] = arr(a, 2)
        Next
    End If
End Sub
对了请给朵小花

凌空一羽

Sub lkyy()
m = Range("a1100").End(3).Row
ar = Sheet2.Range("a1").CurrentRegion
For Each r In Range([c2], Cells(m, 3))
    For i = 2 To UBound(ar)
        If r = ar(i, 3) Then Cells(r.Row, 4) = ar(i, 4): Exit For
    Next
Next
End Sub

罗亮亮

orr89 发表于 2020-1-29 14:49
Private Sub Worksheet_Change(ByVal T As Range)
    If T.Row = 2 And T.Column = 3 Then
        chaz ...

师傅,如果我想改成C列都可以这样联想 怎么做呢?

罗亮亮

凌空一羽 发表于 2020-1-29 15:39
Sub lkyy()
m = Range("a1100").End(3).Row
ar = Sheet2.Range("a1").CurrentRegion

Private Sub Worksheet_Change(ByVal T As Range)
On Error Resume Next
m = Range("a1100").End(3).Row
ar = Sheet2.Range("a1").CurrentRegion
For Each r In Range([c2], Cells(m, 3))
    For i = 2 To UBound(ar)
        If r = ar(i, 3) Then Cells(r.Row, 4) = ar(i, 4): Exit For
    Next
Next
End Sub
大师  想改成C列都可以联想 如何操作

罗亮亮

恭喜发财 恭喜发财 求帮忙 真心学习

罗亮亮

凌空一羽 发表于 2020-1-29 15:39
Sub lkyy()
m = Range("a1100").End(3).Row
ar = Sheet2.Range("a1").CurrentRegion

哥您的代码基本实现不了备注可以修改

凌空一羽

罗亮亮 发表于 2020-1-29 19:56
恭喜发财 恭喜发财 求帮忙 真心学习

Private Sub Worksheet_Change(ByVal T As Range)
On Error Resume Next
If T.Row > 1 And T.Column = 3 Then
    'm = Range("a1100").End(3).Row
    ar = Sheet2.Range("a1").CurrentRegion
    'For Each r In Range([c2], Cells(m, 3))
        For i = 2 To UBound(ar)
            If T.Value = ar(i, 3) Then Cells(T.Row, 4) = ar(i, 4): Exit For
        Next
    'Next
End If
End Sub