两表相减代码出错

rakehell78

Sub CalculateDifference()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim wsDiff As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cell1 As Range
    Dim cell2 As Range
    Dim diff As Double
    Dim newRow As Long
   
    ' 创建新的工作表，用于存放差值
    Set wsDiff = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsDiff.Name = "Difference"
   
    ' 设置要进行求差操作的两个工作表和范围
    Set ws1 = ThisWorkbook.Sheets("Sheet1") ' 第一个工作表
    Set ws2 = ThisWorkbook.Sheets("Sheet2") ' 第二个工作表
    Set rng1 = ws1.Range("A1:E18") ' 第一个表格的范围
    Set rng2 = ws2.Range("A1:E18") ' 第二个表格的范围
   
    ' 循环遍历两个表格的每个单元格，计算差值并写入新工作表
    For Each cell1 In rng1
        For Each cell2 In rng2
            ' 判断标题是否匹配
            If cell1.Offset(-1, 0).Value = cell2.Offset(-1, 0).Value And _
               cell1.Offset(0, -1).Value = cell2.Offset(0, -1).Value Then
                ' 计算差值
                diff = cell1.Value - cell2.Value
                ' 写入差值到新工作表
                newRow = wsDiff.Cells(wsDiff.Rows.Count, 1).End(xlUp).Row + 1
                wsDiff.Cells(newRow, 1).Value = cell1.Offset(-1, 0).Value ' 写入标题行
                wsDiff.Cells(newRow, 2).Value = cell1.Offset(0, -1).Value ' 写入标题列
                wsDiff.Cells(newRow, 3).Value = diff ' 写入差值
                Exit For
            End If
        Next cell2
    Next cell1
   
    ' 提示完成求差操作
    MsgBox "求差操作已完成！"
End Sub

rakehell78

代码提示1004错误

limonet

用到：SQL的LEFT JOIN
为了显示效果，第一行与最后一行改了金额。

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("adodb.connection")
    Cn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
    StrSQL = "select a.费用,a.水费-b.水费,a.垃圾处理费-b.垃圾处理费,a.公摊电费-b.公摊电费,a.物管费-b.物管费 from [Sheet1$]a left join [Sheet2$]b on a.费用=b.费用"
    Sheet6.Range("a2").CopyFromRecordset Cn.Execute(StrSQL)
End Sub