按条件填入数据

少如

学良 发表于 2013-7-30 14:40
老师:  您作的表, 正是我也需要, 下载测试后发现[1号楼1单元]表的 F 列自98行向下,
点击[刷新性名]后,由“ ...

谢谢您的提示,  我也发现了同样的问题.

少如

顶 上 来,  等 老 师 答 案 !

学良

少如 发表于 2013-7-31 07:50
顶 上 来,  等 老 师 答 案 !

呵呵!
     将 "1号楼1单元" 表的 F 列设为 "文本" 型就不会改变了,
您试试看!

dajiahaoxinku12

少如 发表于 2013-7-31 07:50
顶 上 来,  等 老 师 答 案 !

Sub chazhao()
    arr = Sheets("数据库").Range("b5:s" & Range("b65536").End(xlUp).Row)
    brr = Sheets("1号楼1单元").Range("c8:n500")
        For k = 1 To UBound(brr)
           For q = 1 To UBound(arr)
             If brr(k, 4) = arr(q, 4) Then
                brr(k, 1) = arr(q, 1)
                brr(k, 4) = "'" & brr(k, 4)
             End If
             If brr(k, 7) = arr(q, 11) Then
                brr(k, 8) = arr(q, 1)
                brr(k, 7) = "'" & brr(k, 7)
             End If
             If brr(k, 11) = arr(q, 18) Then
                brr(k, 12) = arr(q, 1)
             End If
           Next
        Next
    Sheets("1号楼1单元").Range("c8:n500") = brr
End Sub

少如

dajiahaoxinku12 发表于 2013-7-31 13:09
Sub chazhao()
    arr = Sheets("数据库").Range("b5:s" & Range("b65536").End(xlUp).Row)
    brr = ...

老师:  再看看附件, 为啥直到500行都有数据?
另外, 刷新时, 应先清除原姓名, 否则, 变更房
地下室号或车库号, 造成重复.
谢谢!
匹配复制求助3.zip (35.13 KB, 下载次数: 6)

2013-7-31 16:11 上传

点击文件名下载附件

dajiahaoxinku12

少如 发表于 2013-7-31 16:11
老师:  再看看附件, 为啥直到500行都有数据?
另外, 刷新时, 应先清除原姓名, 否则, 变更房
地下室号或车 ...

Sub chazhao()
    Range("c8:c500,j8:j500,n8:n500").Select
    Selection.ClearContents
    arr = Sheets("数据库").Range("b5:s" & Range("b65536").End(xlUp).Row)
    brr = Sheets("1号楼1单元").Range("c8:n" & Cells(Rows.Count, 6).End(xlUp).Row)
        For k = 1 To UBound(brr)
           For q = 1 To UBound(arr)
             If brr(k, 4) = arr(q, 4) Then
                brr(k, 1) = arr(q, 1)
                brr(k, 4) = "'" & brr(k, 4)
             End If
             If brr(k, 7) = arr(q, 11) Then
                brr(k, 8) = arr(q, 1)
                brr(k, 7) = "'" & brr(k, 7)
             End If
             If brr(k, 11) = arr(q, 18) Then
                brr(k, 12) = arr(q, 1)
             End If
           Next
        Next
    Sheets("1号楼1单元").Range("c8:n" & Cells(Rows.Count, 6).End(xlUp).Row) = brr
End Sub

dajiahaoxinku12

………………………………………………

少如

dajiahaoxinku12 发表于 2013-7-31 21:24
………………………………………………

老师:
    O 列数据不可清除,
请再给看看,谢谢!
匹配复制求助3.zip (33.39 KB, 下载次数: 6)

2013-8-1 12:29 上传

点击文件名下载附件

dajiahaoxinku12

把代码第一句  Range("c8:c500,j8:j500,n8:o500").Select  里面的  最后一个n修改成字母 o  就行了

少如

dajiahaoxinku12 发表于 2013-8-1 13:11
把代码第一句  Range("c8:c500,j8:j500,n8:o500").Select  里面的  最后一个n修改成字母 o  就行了

改了也不行啊,  还请老师给改一下吧,
您辛苦了!