有些按列汇总和按内容查找替换的问题，目前用的Intersect导入数据无问题，删除则报错

风中小菜

先谢过各位老师了，内容有些乱：）也应该有很多小白错误，望见谅，VBA还没入门，之前大量都是用函数进行操作，目前表内很多代码都是东拼西凑网上查的，但最后成品各种出错解决无力了，跪谢先。大致表格描述如下：
       这个表试图进行一些个人数据的处理，首先将得到的原始数据整体复制到数据表，原始数据格式可能是有一定混乱的，需要在校验表内按列首关键字从数据表内汇总过去（目前是只做了将ID从数据表导到校验表对应ID列，其他数据按照如果ID有数据则用 hlookup函数导，但模拟表内没放函数，涉及数据太多直接删了。。）
       此后要将校验表内数据按照关键字C和ID放入输出1表的A列（C）和B列（ID）
       并且校验表内A到O列数据粘贴数值到输出2表格的A2-O列结束（这部分数据其实都是一样的，只是为了实现仅粘贴数值，额，突然发现这部分不用一个个套用Intersect，整体赋值就可以了，自己汗一个，请无视校验表内代码，这个自己能搞定- -）
目前的问题是：
      1. 数据表内得到数据没问题，后续都正常，但是如果是清空删除数据，数据表就会跳错了。
以下两个问题目前是在尝试Worksheet_Change解决，也就是表内数据变化自动执行一次查找替换来保证数据格式统一，（是不是事件的触发也不是能处理所有代码的？）不知道大神们有思路和想法。
      2. 身份证可能有小写x，需要将输出1和输出2表内的身份证小写x统一成大写X（这个目前是录制了宏通过按钮实现的，之前在输出1和输出2表内用以下代码当数据表一粘贴就报错，单独测试就没问题）
Private Sub Worksheet_Change(ByVal Target As Range)    If Target.Column = 2 Then
       Target.Value = UCase(Target.Value)
    End If
End Sub

     3. 这个也是一个查找替换的问题，是希望数据表得到数据就将日期格式内可能含有的特殊字符，像”"空格". - / 年 月 日（）“去除，目前用的是录制的（b- -我也知道很笨很冗长），但是录制的这个碰上worksheet_change也是无法运行(若有相关数据倒是会改过去，没有的话就跳错)..这个也希望大神们帮忙看下有办法解决么
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=".", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Cells.Replace What:="-", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Cells.Replace What:="/", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Cells.Replace What:="年", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Cells.Replace What:="月", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Cells.Replace What:="日", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

总结，好吧，最主要是问题1，问题2和3如果无法实现获取数据自动检查更正的话最多做按钮丑些也是可以完成的- -，再次不甚感激。

蓝桥玄霜

附件中没有数据？怎么知道你的问题在哪里？

风中小菜

蓝桥玄霜 发表于 2016-2-14 10:18
附件中没有数据？怎么知道你的问题在哪里？

的确。。。冒失了，重新上传附件，请帮忙看下，这个主要问题就是数据表内只要关键字下有数据则能顺利复制到其他表，但如果清空数据表，或者关键字下无数据，那么就会报错了。

chenbiao2012

看你描述这半天，思路有问题，你的原始数据在哪？你要达成什么样的目的，只要说明这些即可

chenbiao2012

你可模拟一些数据，然后模拟结果即可，剩下的事交由论坛来做

风中小菜

chenbiao2012 发表于 2016-2-14 23:32
你可模拟一些数据，然后模拟结果即可，剩下的事交由论坛来做

谢谢关注，三楼重新发了，不知是否看得到，这里也重新做了个带数据的模拟上来目前的主要问题就是数据表内复制进数据是没问题的，相应的数据会复制到校验及输出表，但是如果将数据表内数据清空，其实只要发生列首关键字下无数据的情况下，就会跳错。


P.S.当初求助的时候其实是有些乱，因为表格内很多东拼西凑不成体系，想借助各位帮助彻底推翻重来的，哈哈，谢谢您关注，麻烦了。

chenbiao2012

看了半天没明白你所做这一切的目的

chenbiao2012

我看到你的“校验"表内全部是公式，你是想做一个检测的代码来检测原始数据是否存在问题？

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr, i&, Brr, Crr, Myr&
   
3. Sheet2.Activate
   
4. Arr = [a1].CurrentRegion
   
5. ReDim Brr(1 To UBound(Arr) - 1, 1 To 4)
   
6. ReDim Crr(1 To UBound(Arr) - 1, 1 To 3)
   
7. For i = 2 To UBound(Arr)
   
8.     Brr(i - 1, 1) = UCase(Arr(i, 3)): Brr(i - 1, 2) = UCase(Arr(i, 3)): Brr(i - 1, 3) = Arr(i, 2): Brr(i - 1, 4) = Arr(i, 4)
   
9.     Crr(i - 1, 1) = UCase(Arr(i, 3)): Crr(i - 1, 2) = Arr(i, 2):  Crr(i - 1, 3) = Arr(i, 4)
   
10. Next
    
11. With Sheets("校验")
    
12.     Myr = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    
13.     .Cells(Myr, 1).Resize(UBound(Brr), 4) = Brr
    
14. End With
    
15. With Sheets("输出2")
    
16.     Myr = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    
17.     .Cells(Myr, 1).Resize(UBound(Crr), 3) = Crr
    
18. End With
    
19. MsgBox "OK"
    
20. End Sub
    

复制代码

需要去除校验表的保护。

蓝桥玄霜

请见附件。