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

senness · 发表于 2011-4-5 10:57

本帖最后由 senness 于 2011-4-5 12:42 编辑

本人初识VBA，大学时候学的C语言，VB也早已忘光，今天突然接到这个任务，实在无从下手。

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

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

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

附件：

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

2011-4-5 12:42 上传

点击文件名下载附件

热心人士亦可直接联系本人QQ给予解答，本人QQ：1091126346。暗号：VBA。

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2011-4-5 14:15

回复 senness 的帖子

附件：

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

2011-4-5 14:15 上传

点击文件名下载附件

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

复制代码

跳转到最佳答案楼层

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

各位能者帮帮忙~

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

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

单击隐藏图章

回复 senness 的帖子

附件：

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

2011-4-5 14:15 上传

点击文件名下载附件

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

复制代码

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