请大师帮忙,具体在我的模块上的要求,谢谢!

凯哥003

请大师帮忙,具体在我的模块上的要求,谢谢!

lsc900707

先做了第一个：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address <> [e5].Address Then Exit Sub
   
3.     If Len([e5]) Then
   
4.         If [e5] = "32.5R" Then
   
5.              arr = Sheet1.[a1].CurrentRegion
   
6.              ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7.              For i = 8 To UBound(arr) - 1
   
8.                  k = k + 1
   
9.                  For j = 1 To UBound(arr, 2)
   
10.                      brr(k, j) = arr(i, j)
    
11.                  Next
    
12.              Next
    
13.          End If
    
14.          If [e5] = "42.5R" Then
    
15.              arr = Sheet3.[a1].CurrentRegion
    
16.              ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
17.              For i = 8 To UBound(arr) - 1
    
18.                  k = k + 1
    
19.                  For j = 1 To UBound(arr, 2)
    
20.                      brr(k, j) = arr(i, j)
    
21.                  Next
    
22.              Next
    
23.          End If
    
24.     End If
    
25.     [a8:j30].ClearContents
    
26.     If k Then [a8:j8].Resize(k) = brr
    
27. End Sub

复制代码

凯哥003

lsc900707 发表于 2017-4-26 22:41
先做了第一个：

大哥哥:首先表示感谢!我把代码放入<<模板>>工作表做为事件:编译错误:变量未定义,不知如何

lsc900707

凯哥003 发表于 2017-4-26 23:31
大哥哥:首先表示感谢!我把代码放入工作表做为事件:编译错误:变量未定义,不知如何

是不是原来工作表代码区那句强制声明的语句没删掉哦

凯哥003

是啊!大哥哥真是神人,无愧是大师.衷心感谢!

凯哥003

lsc900707 发表于 2017-4-26 23:45
是不是原来工作表代码区那句强制声明的语句没删掉哦

我不急,你要休息好,有空才帮我!

凯哥003

lsc900707 发表于 2017-4-26 23:45
是不是原来工作表代码区那句强制声明的语句没删掉哦

大哥哥:因你好忙,我不忍心老麻烦你,可我老苯,没学过VBA,不好意思.让您费心力.针对这个检验报告单现我做个代码能存到数据库,第一个<<出厂编号>>有对,接下来又再从右重新开始<<出厂编号>>包含其它列的数据全部且重复20多行,现只能求您改下.代码如下:Sub 保存数据()  '
    Dim ar(1 To 27, 1 To 34)
    If [b6] = "" Or [e6] = "" Then
        MsgBox "出厂编号、出厂日期必须全部填写完整方可保存数据。"
        Exit Sub
    End If
    ar(1, 1) = [e5]
    For i = 5 To 27
        If Cells(i, 5) <> "" Then
            m = m + 1
ar(m, 2) = [b6]
ar(m, 3) = [e5]
ar(m, 4) =[e6]  
ar(m, 5) = [h8]
ar(m, 6) = [f9]
ar(m, 7)= [h9]
ar(m, 8) = [j9]
ar(m, 9) = [h10]
     ar(m, 10) = [f11]
ar(m, 11) = [h11]
ar(m, 12) =[j11]  
ar(m, 13) = [h12]
ar(m, 14) = [f13]
ar(m, 15)= [h13]
ar(m, 16) = [j13]
ar(m, 17) = [f14]
   ar(m, 18) = [h14]
ar(m, 19) = [j14]
ar(m, 20) =[h15]  
ar(m, 21) = [f16]
ar(m, 22) = [h16]
ar(m, 23)= [j16]
ar(m, 24) = [h15]
ar(m, 25) = [f17]
ar(m, 26) =[h17]  
ar(m, 27) = [j17]
ar(m, 28) = [e18]
ar(m, 29)= [e21]
ar(m, 30) = [e24]
ar(m, 31) = [e25]
ar(m, 32) = [e26]
ar(m, 33) = [e27]


  End If
    Next
    Sheet4.Range("B" & Sheet4.[c65536].End(3).Row + 1).Resize(m, 34) = ar
End Sub

jjmysjg

哪句没有删掉？

凯哥003

jjmysjg 发表于 2017-4-27 16:08
哪句没有删掉？

谢谢!我代码错了,改了下好了,我是自学的,好笨,现是一按会重复加上一行

凯哥003

lsc900707 发表于 2017-4-26 23:45
是不是原来工作表代码区那句强制声明的语句没删掉哦

大哥哥,我一直在改,现好了,因我是从事质量检验的,为了方便,才自学一个多月的,在WPS上做的.我人好笨.现不懂从数据库往回引,列如:在出厂编号输入2017-3012能调回数据方便查询和打印,请您幸苦下,太感谢您的无私奉献