excel - 创建循环以从三个工作表中复制整个列并将它们排序到新工作表中
问题描述
我是 VBA 新手,在编写某个宏时遇到了问题。我从数据库中检索了大约 150 只债券的每日收益率、要价和买入价的数据。所有收益率、卖出价和买入价都在不同的表格中按顺序排序。我想为每只债券获得一张带有相应收益率、买入价和卖出价的新表。我的收益率在表 2 中,要价在表 3 中,买入价在表 4 中。它应该始终复制两个完整列,例如对于第一个债券,它应该复制前两列(两列,因为一个是产量和一个带有日期)的表 2、表 3 的前 2 列和表 4 的前两列,并将它们彼此相邻放在新表中,对于下一个债券,它应该复制每个表的下两列工作表并将其复制到新工作表中,依此类推。
以下是我为前两个债券手动执行的宏的记录
ActiveCell.Offset(0, -6).Columns("A:B").EntireColumn.Select
ActiveCell.Offset(0, -6).Range("A1").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
Sheets("Sheet3").Select
ActiveCell.Columns("A:B").EntireColumn.Select
ActiveCell.Offset(1, 0).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet7").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet4").Select
ActiveCell.Columns("A:B").EntireColumn.Select
ActiveCell.Offset(1, 0).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet7").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
ActiveCell.Offset(0, 2).Columns("A:B").EntireColumn.Select
ActiveCell.Offset(0, 2).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet8").Select
ActiveSheet.Paste
Sheets("Sheet3").Select
ActiveCell.Offset(0, 2).Range("A1:B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Ask Close"
ActiveCell.Columns("A:B").EntireColumn.Select
ActiveCell.Activate
Selection.Copy
Sheets("Sheet8").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet4").Select
ActiveCell.Offset(0, 2).Columns("A:B").EntireColumn.Select
ActiveCell.Offset(0, 2).Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet8").Select
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
解决方案
只要您的工作表都具有默认名称,这应该可以满足您的要求。
Option Explicit
Sub copyColtoSheet()
Dim pasteSheet As Worksheet
Dim copySheet As Worksheet
Dim i As Integer
'Create new sheet to paste column data to
With ThisWorkbook
.Sheets.Add After:=.Sheets(.Sheets.Count)
Set pasteSheet = .Worksheets("Sheet" & .Sheets.Count)
End With
'Copy Sheet columns to new sheet
Dim pasteColumn As Integer
pasteColumn = 1
For i = 2 To 4
With pasteSheet
Dim allRows As Integer
Set copySheet = ThisWorkbook.Worksheets("Sheet" & i)
allRows = copySheet.Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Range(.Cells(1, pasteColumn), .Cells(allRows, pasteColumn)), .Range(.Cells(1, pasteColumn + 1), .Cells(allRows, pasteColumn + 1))).Value = copySheet.Range("A:B").Value
pasteColumn = pasteColumn + 2
End With
Next i
End Sub
我已经测试了这段代码并且它有效。
推荐阅读
- javascript - redux reducer 不听动作
- java - 如何将扫描仪输入添加到队列并在输入读取后退出循环
- node.js - 使用云功能创建pdf文件并将其上传到firebase存储?(可以上传本地文件,但不能从云端功能上传)
- microsoft-graph-api - 在 Exchange 中创建消息导致“UnableToDeserializePostBody”
- python - 选择下拉列表中的一个元素 -selenium -python
- c - 如何使用 clang 本机矢量语法(无内在函数)进行 AVX 矢量混合?
- r - 有没有办法按组计算比例?
- arrays - 子更新崩溃表(indexPath 超出范围错误导致我的应用程序崩溃错误)
- javascript - 在新的 Promise 中使用功能组件的 setState?
- arm - 从c中的struct定义指向数组的指针