Question

我有两个不同的工作表。我必须从第一张纸上复制第一列（A）。根据第一列中的字符串，从第一列复制数据，从第一页复制第二列（B），从第二列复制第二列（B），然后找出两个复制列之间的差异。所有这些数据都将粘贴到新工作表中。重复此过程以从第一张纸复制第三列（C），从第二张复制第三列（C），然后找出差异。重复此过程直到最后一列。

如何使代码动态化，使其在工作表的第一列中查找数据，然后从其他列复制数据。

我能够使用WWC的帮助使这个代码工作，但是如何在第一列中查找数据然后复制值。

    Sub Macro4()
'
' Macro4 Macro
'

'
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Dim coli As Double
Dim Coli3 As Double
Dim rowy As Double

Dim numCols As Double
Dim startRow As Double
Dim lastRow As Double

startRow = 6 'assuming data starts here
Coli3 = 2 ' start the columns out on ws3

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws3 = ThisWorkbook.Worksheets("Comparison")

Application.ScreenUpdating = False

ws3.Cells.Clear


ws1.Range("A1").EntireColumn.Copy Destination:=ws3.Range("A1")

'Find how many columns there are in sheet1 based on data in row 1
numCols = ws1.Cells(7, Columns.Count).End(xlToLeft).Column
For coli = 2 To numCols
    'Find last Data row in the given column in sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, coli).End(xlUp).Row

    For rowy = 6 To lastRow
        ws3.Cells(rowy, Coli3) = Format(ws1.Cells(rowy, coli).Value, "#,##0") ' copy sheet 1 to the right spot of sheet 3
        ws3.Cells(rowy, Coli3 + 1) = Format(ws2.Cells(rowy, coli).Value, "#,##0") 'copy sheet 2 to the right spot of sheet 3
        'perform calculation and place in the right spot on sheet 3
        If rowy = "6" Then
            ws3.Cells(rowy, Coli3) = ws1.Cells(rowy, coli) & "-Sheet1" ' copy sheet 1 to the right spot of sheet 3
            ws3.Cells(rowy, Coli3 + 1) = ws2.Cells(rowy, coli) & "-Sheet2" 'copy sheet 2 to the right spot of sheet 3
            ws3.Cells(rowy, Coli3 + 2) = "Difference"
        Else
            ws3.Cells(rowy, Coli3) = Format(ws1.Cells(rowy, coli).Value, "#,##0") ' copy sheet 1 to the right spot of sheet 3
            'ws3.Cells(rowy, Coli3).Font.Name = "Arial"
            'ws3.Cells(rowy, Coli3).Font.Size = 8
            ws3.Cells(rowy, Coli3 + 1) = Format(ws2.Cells(rowy, coli).Value, "#,##0") 'copy sheet 2 to the right spot of sheet 3
            'ws3.Cells(rowy, Coli3 + 1).Font.Name = "Arial"
            'ws3.Cells(rowy, Coli3 + 1).Font.Size = 8
            ws3.Cells(rowy, Coli3 + 2) = Format((ws1.Cells(rowy, coli).Value) - (ws2.Cells(rowy, coli).Value), "#,##0")
            'ws3.Cells(rowy, Coli3 + 2).Font.Name = "Arial"
            'ws3.Cells(rowy, Coli3 + 2).Font.Size = 8
        End If

    Next rowy ' move to the next row on ws1, ws2, ws3

    'Since we are placing 3 cols at a time in sheet 3 we increment differently
    Coli3 = Coli3 + 3 '1 becomes 4, 4 becomes 7, 7 becomes 10 and so on


End Sub

Data in the Sheets

Answer 1

好的是，要找到表A和表B之间各列中每个单元格之间的差异，并将其放在表单C上的相应单元格中，不需要复制，除非您真的希望我们可以为此配置答案这是一项要求。这是一个在3个工作表上运行的宏，它取决于工作表1和工作表2的不同，并逐个列地逐个单元地将它放在工作表3中。它确定包含数据的列数，它确定列中的最后一行数据。 A和B表上的列总是长度相同吗？如果这有助于你，请告诉我。

Sub diff_macro()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Dim coli As Double
Dim rowy As Double

Dim numCols As Double
Dim startRow As Double
Dim lastRow As Double

startRow = 1 'assuming data starts in column 1

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws3 = ThisWorkbook.Worksheets("Sheet3")

'Find how many columns there are in sheet1 based on data in row 1
numCols = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

For coli = 1 To numCols
    'Find last Data row in the given column in sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, coli).End(xlUp).Row

    For rowy = 1 To lastRow ' go through each row and perform the difference calculation
        ws3.Cells(rowy, coli) = (ws1.Cells(rowy, coli).Value) - (ws2.Cells(rowy, coli).Value)

    Next rowy ' move to the next row on ws1, ws2, ws3

Next coli 'move to next column on ws1, ws2, ws3


End Sub

干杯，WWC

Answer 2

如果你真的想要（1）表A值然后（2）表B值然后（3）差异，这里是复制A，复制B，然后执行Calc的宏的简单修改，将有一个aa在表C中有很多列，因为你为表A中的每个col生成了3个cols。但是这样就可以了。如果你有列的标题，那么startRow应该是2.你可以运行一个单独的for循环来将标题放在C上，或者根据第1行编写一个if语句，它与当前for循环中的其余部分的行为不同。

在这里，稍微修改为＆＃34; copy＆＃34; cols到表C：

Sub diff_macro()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Dim coli As Double
Dim Coli3 As Double
Dim rowy As Double

Dim numCols As Double
Dim startRow As Double
Dim lastRow As Double

startRow = 1 'assuming data starts in column 1
Coli3 = 1 ' start the columns out on ws3 at column 1

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws3 = ThisWorkbook.Worksheets("Sheet3")

'Find how many columns there are in sheet1 based on data in row 1
numCols = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

For coli = 1 To numCols
    'Find last Data row in the given column in sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, coli).End(xlUp).Row

    For rowy = 1 To lastRow
        ws3.Cells(rowy, Coli3).Value = ws1.Cells(rowy, coli).Value ' copy sheet 1 to the right spot of sheet 3
        ws3.Cells(rowy, Coli3 + 1).Value = ws2.Cells(rowy, coli).Value 'copy sheet 2 to the right spot of sheet 3
        'perform calculation and place in the right spot on sheet 3
        ws3.Cells(rowy, Coli3 + 2).Value = (ws1.Cells(rowy, coli).Value) - (ws2.Cells(rowy, coli).Value)

    Next rowy ' move to the next row on ws1, ws2, ws3

    'Since we are placing 3 cols at a time in sheet 3 we increment differently
    Coli3 = Coli3 + 3 '1 becomes 4, 4 becomes 7, 7 becomes 10 and so on

Next coli 'move to next column on ws1, ws2

End Sub

希望这些让你更接近你想要的地方。干杯，WWC

Answer 3

还有一个答案，这个可以帮助您解决您尝试过的代码。您已经通过定义第一行和最后一行来定义范围中的列，然后释放整个列副本。此外，您不需要为副本指定范围（大小），只需选择目标列中的顶部单元格或其他单元格。这两行工作正常，如果你想坚持你的代码，那么相应地修改。这将表A上的列的内容复制到表C，很容易为B执行相同的操作。但它可以工作。如果您定义范围，则转储整个列副本，我猜测整个列副本只需要列号，并且不需要范围。

'Find how many columns there are in sheet1 based on data in row 1
numCols = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

For coli = 1 To numCols
    'Find last Data row in the given column in sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, coli).End(xlUp).Row

    ws1.Range(Cells(1, coli), Cells(lastRow, coli)).Copy 'you defined the range you don't need anything else
    ws3.Cells(1, coli).PasteSpecial 'you can place conditions here if you wish

Next coli 'move to next column on ws1, ws2

你去吧。 -WWC

如何动态复制excel VBA中两个不同工作表的数据？

3 个答案: