VBA-将特定列数据从多个工作表复制为一个-Java 学习之路

我有一个非常典型的场景，需要将来自不同工作表（在同一工作簿中）的两列复制到单个工作表 .

Source workbook name: Mycalc.xlsm

Worksheets name: Sheet1，sheet2，sheet3（还有其他工作表，但仅针对上述内容执行操作）

Target Workbook Name: Mycalc.xlsm

Target worksheet name: 合并

Condition:

不能为工作簿中的所有工作表执行每个工作表作为仅在上述三个工作表上执行的操作 .
列 Headers 在所有工作表中的顺序不一定相同，但 Headers 相同 .

enter image description here

Result Expected: 结果是来自所有3张纸的合并数据以及提示数据复制的纸张的列表名称 .

我不是这方面的专家，因此无论我取得了什么，我都不会粘贴代码 . 添加它，我已经通过在命名范围中添加工作表名称作为列表（在工作簿中我创建了一个具有工作表名称列表的表格，并且在该范围内执行每个工作簿） .

enter image description here

stackoverflow的专家，请帮帮我 .

问候，

玛尼

2 回答

1

我已经使用了命名范围的概念作为工作表名称 . 经过多次跨栏和耗时的研究 . 这是一个简单的，编译和工作的代码 .

Public Sub ExportData（）

Dim TransCol（1到2）As String
Dim ImportWS作为工作表
Dim SheetsName作为范围
Dim FindColumn，TargetColumn As Range
Dim RowCount一样长
Dim RowIndex，i，Column As Long
Dim LastUsedRow一样长
Dim LastUsedRowCount As Variant

TransCol（1）=“ISIN”
TransCol（2）=“当天调整”

对于每个SheetsName在sheet3.Range（“tblSheetNames”） . 单元格

如果Len（SheetsName.Value）> 0那么

设置ImportWS = ThisWorkbook.Sheets（SheetsName.Value）
ImportWS.Activate

对于Column = 1到2

设置FindColumn = ImportWS.Cells.Find（TransCol（Column），searchorder：= xlByRows，searchdirection：= xlNext）
RowCount = FindColumn.Cells（200000,1）.End（xlUp）.Row
设置TargetColumn = sheet3.Cells.Find（TransCol（Column），searchorder：= xlByRows，searchdirection：= xlNext）

对于i = FindColumn.Row To RowCount

LastUsedRow = sheet3.Cells（200000，TargetColumn.Column）.End（xlUp）.Row
sheet3.Cells（LastUsedRow 1，TargetColumn.Column）.Value = ImportWS.Cells（i 1，FindColumn.Column）.Value

下一个我

下一栏
万一

下一个
结束子

**注意：**我已将代码移动到模块而不是后面的工作簿代码 .

很高兴解释，如果需要更多信息 . 谢谢你们 .

问候，

玛尼

回复于 2024-04-29T18:19:12+08:00

你不值得从头开始，没有统一化或努力，否则无处可去 .
因为你真的很难评论代码 . 如果我_2333391_回应 .

Sub ertdfgcvb()
ExportWS = "Merged"
Dim ImportWS(1 To 3) As String
    ImportWS(1) = "Sheet1"
    ImportWS(2) = "sheet2"
    ImportWS(3) = "sheet3"
Dim TransCol(1 To 2) As String
    TransCol(1) = "Current Day Adjustment"
    TransCol(2) = "ISIN"
For i = 1 To 3 'for each import sheet
    FirstImportRow = Worksheets(ImportWS(i)).Cells.Find(TransCol(1), SearchOrder:=xlByRows, SearchDirection:=xlNext).Row + 1
    LastImportRow = Worksheets(ImportWS(i)).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    DiffRows = LastImportRow - FirstImportRow
    FirstExportRow = Worksheets(ExportWS).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    ExportColumn = Worksheets(ExportWS).Cells.Find("Sheet Name", SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the sheet name
    Worksheets(ExportWS).Range(Cells(FirstExportRow, ExportColumn), Cells(FirstExportRow + DiffRows, ExportColumn)) = ImportWS(i)
    For j = 1 To 2 'for each column that has to be transported
        ExportColumn = Worksheets(ExportWS).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data
        ImportColumn = Worksheets(ImportWS(i)).Cells.Find(TransCol(j), SearchOrder:=xlByRows, SearchDirection:=xlNext).Column 'defines where to insert the data from
        For k = 0 To DiffRows
            Worksheets(ExportWS).Cells(FirstExportRow + k, ExportColumn) = Worksheets(ImportWS(i)).Cells(FirstImportRow + k, ImportColumn)
        Next
    Next

Next
End Sub

回复于 2024-04-29T18:19:12+08:00

VBA-将特定列数据从多个工作表复制为一个

2 回答

相关问题