求助高手用VBA实现销售数据库？

巴拉马

HBINIKJNOJK.rar (11.55 KB, 下载次数: 23)

2014-7-28 10:44 上传

点击文件名下载附件

000

青见

想建立一个理想的数据库必须建一个无重复的序号，因为日期很可能有重复，对查找与修改都有问题

巴拉马

青见 发表于 2014-7-28 14:02
想建立一个理想的数据库必须建一个无重复的序号，因为日期很可能有重复，对查找与修改都有问题

如果把日期的月和日分开呢？

巴拉马

没人会吗？555555555555555！！！！！！！！！！！

琼恩·雪诺

巴拉马 发表于 2014-7-28 16:27
没人会吗？555555555555555！！！！！！！！！！！

这种没有技术含量的重复性工作，没人愿意帮你做完，你还是自学下吧

xinjiana

巴拉马 发表于 2014-7-28 14:42
如果把日期的月和日分开呢？

这与合并在一起的有什么区别吗？
你不如搜索一下论坛里现有的，找一个合适的用用

SycoVictor

1. Sub test1()
   
2.     Application.ScreenUpdating = False
   
3.     Dim arr, i&, j&
   
4.     If Cells(65536, 6).End(3).Row = 2 Then
   
5.         Exit Sub
   
6.     End If
   
7.     arr = Range(Cells(3, 1), Cells(65536, 6).End(3))
   
8.     ReDim brr(1 To UBound(arr), 1 To 3)
   
9.     For i = 1 To UBound(brr)
   
10.         brr(i, 1) = Cells(1, 2)
    
11.         brr(i, 2) = Cells(1, 3)
    
12.         brr(i, 3) = Cells(1, 4)
    
13.     Next
    
14.     Range(Cells(3, 1), Cells(65536, 6).End(3)).ClearContents
    
15.     With Worksheets(2)
    
16.         .Cells(.Cells(65536, 1).End(3).Row + 1, 1).Resize(UBound(brr), UBound(brr, 2)) = brr
    
17.         .Cells(.Cells(65536, 4).End(3).Row + 1, 4).Resize(UBound(arr), UBound(arr, 2)) = arr
    
18.         .Cells(1, 1).CurrentRegion.Borders.LineStyle = xlContinuous
    
19.     End With
    
20.     Application.ScreenUpdating = True
    
21. End Sub
    
22. 
    
23. Sub test2()
    
24.     Application.ScreenUpdating = False
    
25.     Dim arr, brr, i&, j&
    
26.     With Worksheets(2)
    
27.         For i = 1 To .Cells(65536, 1).End(3).Row
    
28.             If .Cells(i, 1) = Cells(1, 10) And .Cells(i, 2) = Cells(1, 11) And .Cells(i, 3) = Cells(1, 12) Then
    
29.                 .Range(.Cells(i, 4), .Cells(i, 9)).Copy Cells(Cells(65536, 9).End(3).Row + 1, 9)
    
30.                 .Rows(i).Delete
    
31.                 i = i - 1
    
32.             End If
    
33.         Next
    
34.     End With
    
35.     Application.ScreenUpdating = False
    
36. End Sub
    
37. 
    
38. Sub test3()
    
39.     Application.ScreenUpdating = False
    
40.     Dim arr, i&, j&
    
41.     If Cells(65536, 9).End(3).Row = 2 Then
    
42.         Exit Sub
    
43.     End If
    
44.     arr = Range(Cells(3, 9), Cells(65536, 14).End(3))
    
45.     ReDim brr(1 To UBound(arr), 1 To 3)
    
46.     For i = 1 To UBound(brr)
    
47.         brr(i, 1) = Cells(1, 10)
    
48.         brr(i, 2) = Cells(1, 11)
    
49.         brr(i, 3) = Cells(1, 12)
    
50.     Next
    
51.     Range(Cells(3, 9), Cells(65536, 14).End(3)).ClearContents
    
52.     With Worksheets(2)
    
53.         .Cells(.Cells(65536, 1).End(3).Row + 1, 1).Resize(UBound(brr), UBound(brr, 2)) = brr
    
54.         .Cells(.Cells(65536, 4).End(3).Row + 1, 4).Resize(UBound(arr), UBound(arr, 2)) = arr
    
55.         .Cells(1, 1).CurrentRegion.Borders.LineStyle = xlContinuous
    
56.     End With
    
57.     Application.ScreenUpdating = True
    
58. End Sub
    

复制代码

来了来了 ...

巴拉马

SycoVictor 发表于 2014-7-28 20:58
来了来了 ...

太感谢...............如果可以，叫你师傅行吗？

巴拉马

琼恩·雪诺 发表于 2014-7-28 20:14
这种没有技术含量的重复性工作，没人愿意帮你做完，你还是自学下吧

看看下面的大神吧，哥

巴拉马

xinjiana 发表于 2014-7-28 20:42
这与合并在一起的有什么区别吗？
你不如搜索一下论坛里现有的，找一个合适的用用

有区别的，他用在仓库很适合，经常有差错适合根改