我想在两张不同的纸张上合并两张不同的表格并将结果粘贴到另一张纸张的另一张表格上?
例如,SUM:
sheet 1 ("A1") = 1
sheet 2 ("A1") = 2
PASTE to: sheet 3 ("A1") = 3
我的表格动态且大(“A1:D27”),我找不到按顺序遍历每个单元格并粘贴到下一个单元格的方法?
我试图循环每个单元格但没有工作,我尝试复制粘贴并添加但不使用动态范围。
答案 0 :(得分:1)
这个功能可以解决问题:
这在测试中对我有用:
Sub SumValues()
' Get reference to the sheets
Dim Sheet1 As Worksheet
Set Sheet1 = ActiveWorkbook.Sheets(1)
Dim Sheet2 As Worksheet
Set Sheet2 = ActiveWorkbook.Sheets(2)
Dim Sheet3 As Worksheet
Set Sheet3 = ActiveWorkbook.Sheets(3)
' Find largest used range
' Sheet1
FirstRowS1 = Sheet1.UsedRange.Rows(1).Row
LastRowS1 = Sheet1.UsedRange.Rows(Sheet1.UsedRange.Rows.Count).Row
FirstColS1 = Sheet1.UsedRange.Columns(1).Column
LastColS1 = Sheet1.UsedRange.Columns(Sheet1.UsedRange.Columns.Count).Column
' Sheet2
FirstRowS2 = Sheet2.UsedRange.Rows(1).Row
LastRowS2 = Sheet2.UsedRange.Rows(Sheet2.UsedRange.Rows.Count).Row
FirstColS2 = Sheet2.UsedRange.Columns(1).Column
LastColS2 = Sheet2.UsedRange.Columns(Sheet2.UsedRange.Columns.Count).Column
' Largest used range is min rows to max rows and min columns to max columns
' Minimum row from both sheeets
MinRow = 0
If FirstRowS1 < FirstRowS2 Then
MinRow = FirstRowS1
Else
MinRow = FirstRowS2
End If
' Maximum row from both sheeets
MaxRow = 0
If LastRowS1 > LastRowS2 Then
MaxRow = LastRowS1
Else
MaxRow = LastRowS2
End If
' Minimum column from both sheeets
MinCol = 0
If FirstColS1 < FirstRowS2 Then
MinCol = FirstColS1
Else
MinCol = FirstColS2
End If
' Maximum column from both sheeets
MaxCol = 0
If LastColS1 < LastRowS2 Then
MaxCol = LastColS1
Else
MaxCol = LastColS2
End If
' Clear Sheet3
Sheet3.Cells.Clear
' Cycle through largest range that is used
For Row = MinRow To MaxRow
For Col = MinCol To MaxCol
Sheet3.Cells(Row, Col).Value = Sheet1.Cells(Row, Col).Value + Sheet2.Cells(Row, Col).Value
Next col
Next Row
End Sub