[已解决]各位学VBA、懂VBA的帮个忙，就当做个练习占用略少时间帮忙做个任务，不胜感激！

senness · 发表于 2011-4-5 11:32

本帖最后由 senness 于 2011-4-5 13:06 编辑

（之前附件传错，误传一个教学文档，现在附件已改正，恳请各位帮忙！）

里面就是一个任务：写一个VBA程序来控制不同表里的数据。使各个数据库更有效率的整合起来。

内容并不复杂，恳请各位帮个忙。

本人初识VBA，大学时候学的C语言，VB也早已忘光，今天朋友急事要写这个程序，实在无从下手。

走投无路之际来到这个精英论坛，拜托各位高手能施以援助，占用略少时间权当做个练习也好。

若能施以援手，本人万分感激。

任务内容附件已上传，再次恳请各位高手帮个忙。

附件：

Excel vba practice.rar (11.42 KB, 下载次数: 22)

2011-4-5 12:28 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2011-4-5 14:06

附件：

Excel vba practice.rar (19.6 KB, 下载次数: 10)

2011-4-5 14:06 上传

点击文件名下载附件

Sub 综合()
'复制
Dim Ro, Roo, i As Long
Ro = Sheets("Source 1").[A65536].End(xlUp).Row
Roo = Sheets("Output").[A65536].End(xlUp).Row + 1
Sheets("Source 1").Range("A5:A" & Ro).Copy Sheets("Output").Range("B" & Roo)
Sheets("Source 1").Range("C5:C" & Ro).Copy Sheets("Output").Range("A" & Roo)
Sheets("Source 1").Range("F5:F" & Ro).Copy Sheets("Output").Range("D" & Roo)
Sheets("Source 1").Range("G5:G" & Ro).Copy Sheets("Output").Range("E" & Roo)
Sheets("Source 1").Range("H5:H" & Ro).Copy Sheets("Output").Range("C" & Roo)
Ro = Sheets("Source 2").[A65536].End(xlUp).Row
Roo = Sheets("Output").[A65536].End(xlUp).Row + 1
Sheets("Source 2").Range("A7:A" & Ro).Copy Sheets("Output").Range("B" & Roo)
Sheets("Source 2").Range("B7:B" & Ro).Copy Sheets("Output").Range("A" & Roo)
Sheets("Source 2").Range("C7:C" & Ro).Copy Sheets("Output").Range("C" & Roo)
Sheets("Source 2").Range("E7:E" & Ro).Copy Sheets("Output").Range("D" & Roo)
Sheets("Source 2").Range("F7:F" & Ro).Copy Sheets("Output").Range("E" & Roo)
'删除
i = 4
Ro = 6
Roo = Sheets("Output").[A65536].End(xlUp).Row
For Ro = 6 To Roo
For i = 4 To Sheets("Lookups").[B65536].End(xlUp).Row
If Sheets("Lookups").Cells(i, 2) = Sheets("Output").Cells(Ro, 4) Then
If Sheets("Lookups").Cells(i, 3) = "No" Then
Range("D" & Ro).EntireRow.Delete
End If
End If
Next i
Next Ro
'排序
Range("A6:E65536").Select
ActiveWorkbook.Worksheets("Output").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("C6:C16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Output").Sort
.SetRange Range("A5:E65536")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

复制代码

跳转到最佳答案楼层

sunjing-zxl · 发表于 2011-4-5 11:58

回复 senness 的帖子

你发的附件是讲座资料啊。。没有看到你的问题是什么啊？？？

FF7 · 发表于 2011-4-5 12:04

本帖最后由 FF7 于 2011-4-5 14:23 编辑

误会！！

senness · 发表于 2011-4-5 12:31

回复 sunjing-zxl 的帖子

不好意思，附件传错了~本来想下个入门教材试试的，但是因为是急用，重新开始学又来不及，所以才不得不上论坛来求援的。
麻烦高手们帮个忙。

senness · 发表于 2011-4-5 12:38

回复 FF7 的帖子

唉，您误会了，我自己不是学这个的，工作也用不着这个。上面的附件传错了，我已经重新传了，是一个EXCEL的VBA任务。
是为了帮一个朋友争取一个关键的工作机会，而且时间紧迫，出于无奈才来论坛求助的。
也不知道做这个时间长短，如果朋友有心的话就帮帮忙。万分感谢。

sunjing-zxl · 发表于 2011-4-5 12:52

回复 senness 的帖子

那你也该把你的目的说清楚啊，都不知道你要干什么啊

senness · 发表于 2011-4-5 12:59

回复 sunjing-zxl 的帖子

不好意思，是我说的不够清楚。
里面就是一个任务：写一个VBA程序来控制不同表里的数据。使各个数据库更有效率的整合起来。

如果朋友你懂VBA的话，恳请帮忙试试，只要把VBA程序简单的写一下即可。

sunjing-zxl · 发表于 2011-4-5 14:06

这个最佳答案由 sunjing-zxl 给出，感谢 sunjing-zxl 的回答。

单击隐藏图章

附件：

Excel vba practice.rar (19.6 KB, 下载次数: 10)

2011-4-5 14:06 上传

点击文件名下载附件

Sub 综合()
'复制
Dim Ro, Roo, i As Long
Ro = Sheets("Source 1").[A65536].End(xlUp).Row
Roo = Sheets("Output").[A65536].End(xlUp).Row + 1
Sheets("Source 1").Range("A5:A" & Ro).Copy Sheets("Output").Range("B" & Roo)
Sheets("Source 1").Range("C5:C" & Ro).Copy Sheets("Output").Range("A" & Roo)
Sheets("Source 1").Range("F5:F" & Ro).Copy Sheets("Output").Range("D" & Roo)
Sheets("Source 1").Range("G5:G" & Ro).Copy Sheets("Output").Range("E" & Roo)
Sheets("Source 1").Range("H5:H" & Ro).Copy Sheets("Output").Range("C" & Roo)
Ro = Sheets("Source 2").[A65536].End(xlUp).Row
Roo = Sheets("Output").[A65536].End(xlUp).Row + 1
Sheets("Source 2").Range("A7:A" & Ro).Copy Sheets("Output").Range("B" & Roo)
Sheets("Source 2").Range("B7:B" & Ro).Copy Sheets("Output").Range("A" & Roo)
Sheets("Source 2").Range("C7:C" & Ro).Copy Sheets("Output").Range("C" & Roo)
Sheets("Source 2").Range("E7:E" & Ro).Copy Sheets("Output").Range("D" & Roo)
Sheets("Source 2").Range("F7:F" & Ro).Copy Sheets("Output").Range("E" & Roo)
'删除
i = 4
Ro = 6
Roo = Sheets("Output").[A65536].End(xlUp).Row
For Ro = 6 To Roo
For i = 4 To Sheets("Lookups").[B65536].End(xlUp).Row
If Sheets("Lookups").Cells(i, 2) = Sheets("Output").Cells(Ro, 4) Then
If Sheets("Lookups").Cells(i, 3) = "No" Then
Range("D" & Ro).EntireRow.Delete
End If
End If
Next i
Next Ro
'排序
Range("A6:E65536").Select
ActiveWorkbook.Worksheets("Output").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("C6:C16") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Output").Sort
.SetRange Range("A5:E65536")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

复制代码

FF7 · 发表于 2011-4-5 14:13

本帖最后由 FF7 于 2011-4-5 14:18 编辑

楼主的这个题目，如果用SQL来做，可能最简洁快速。如果能有高手提供解法最好不过。

我的附件全部采用最基础的循环方法来做的，为加快运算速度，将所有数据加入到数组后进行处理。
代码添加了注释，希望你的朋友能够看懂。

senness · 发表于 2011-4-5 14:30

回复 sunjing-zxl 的帖子

万分感谢~~~不知道说什么好~~~
真的多谢多谢~~~

		自动登录	找回密码
密码			注册

[已解决]各位学VBA、懂VBA的帮个忙，就当做个练习占用略少时间帮忙做个任务，不胜感激！

评分

评分