Excel宏助手

```vba
Sub 创建预算表()
    Dim ws As Worksheet
    Dim i As Integer
    Dim 月份() As String
    Dim 开始行 As Integer
    
    ' 定义月份数组
    月份 = Array("一月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "十一月", "十二月")
    
    ' 创建新的工作表
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "预算表"

    ' 设置标题
    ws.Cells(1, 1).Value = "月份"
    ws.Cells(1, 2).Value = "收入"
    ws.Cells(1, 3).Value = "开支"
    ws.Cells(1, 4).Value = "盈亏"
    ws.Cells(1, 5).Value = "备注"
    
    ' 填充月份数据
    开始行 = 2
    For i = 0 To UBound(月份)
        ws.Cells(开始行 + i, 1).Value = 月份(i)
    Next i
    
    ' 设置公式计算盈亏
    For i = 开始行 To 开始行 + 11
        ws.Cells(i, 4).Formula = "=B" & i & "-C" & i ' 盈亏 = 收入 - 开支
    Next i
    
    ' 添加总计行
    ws.Cells(开始行 + 12, 1).Value = "总计"
    ws.Cells(开始行 + 12, 2).Formula = "=SUM(B" & 开始行 & ":B" & 开始行 + 11 & ")" ' 收入总计
    ws.Cells(开始行 + 12, 3).Formula = "=SUM(C" & 开始行 & ":C" & 开始行 + 11 & ")" ' 开支总计
    ws.Cells(开始行 + 12, 4).Formula = "=B" & 开始行 + 12 & "-C" & 开始行 + 12 ' 盈亏总计

    ' 设置格式
    ws.Columns("A:E").AutoFit
    ws.Range("A1:E1").Font.Bold = True
    ws.Range("A1:E1").Interior.Color = RGB(200, 200, 200)
    ws.Range("B2:D" & 开始行 + 12).NumberFormat = "0.00"
    ws.Range("A" & 开始行 + 12 & ":E" & 开始行 + 12).Font.Bold = True
    
    MsgBox "预算表已创建完成！", vbInformation
End Sub
```

```vba
Sub CreatePivotTable()
    Dim ws As Worksheet
    Dim pivotWs As Worksheet
    Dim dataRange As Range
    Dim pivotTable As PivotTable
    Dim pivotCache As PivotCache
    Dim pivotTableName As String
    Dim lastRow As Long
    Dim lastCol As Long
    
    ' Set up the source data sheet
    Set ws = ThisWorkbook.Worksheets("SalesData") ' Replace with the name of your sales data sheet
    
    ' Determine last row and column of the data range
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' Define data range
    Set dataRange = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))
    
    ' Add new worksheet for the Pivot Table
    On Error Resume Next
    Set pivotWs = ThisWorkbook.Worksheets("PivotTable")
    On Error GoTo 0
    If pivotWs Is Nothing Then
        Set pivotWs = ThisWorkbook.Worksheets.Add
        pivotWs.Name = "PivotTable"
    Else
        pivotWs.Cells.Clear
    End If
    
    ' Create Pivot Cache
    Set pivotCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange)
    
    ' Set the name for Pivot Table
    pivotTableName = "SalesPivotTable"
    
    ' Create Pivot Table
    Set pivotTable = pivotCache.CreatePivotTable(TableDestination:=pivotWs.Cells(1, 1), TableName:=pivotTableName)
    
    ' Configure Pivot Table fields
    With pivotTable
        ' Add Row field
        .PivotFields("Date").Orientation = xlRowField
        .PivotFields("Date").Grouping GroupBy:=Array("Months", "Years")
        
        ' Add Column field
        .PivotFields("Region").Orientation = xlColumnField
        
        ' Add Value field
        .PivotFields("Revenue").Orientation = xlDataField
        .PivotFields("Revenue").Function = xlSum
        .PivotFields("Revenue").NumberFormat = "$#,##0.00"
        
        ' Add additional Value field for Quantity if needed
        .PivotFields("Quantity").Orientation = xlDataField
        .PivotFields("Quantity").Function = xlSum
    End With
    
    ' Auto-fit columns on the pivot sheet
    pivotWs.Cells.Columns.AutoFit
    
    MsgBox "Pivot table successfully created.", vbInformation
End Sub
``` 

Make sure to replace `"SalesData"` and column names (e.g., `"Date"`, `"Region"`, `"Revenue"`, `"Quantity"`) with the actual worksheet name and field names from your dataset.

```vba
Sub 差异数据校准及错误标注()

    ' 获取用户选择的两张表的工作表
    Dim ws表1 As Worksheet
    Dim ws表2 As Worksheet
    Dim ws结果 As Worksheet
    Dim rng表1 As Range
    Dim rng表2 As Range
    Dim dict表1 As Object
    Dim dict表2 As Object

    ' 创建字典对象
    Set dict表1 = CreateObject("Scripting.Dictionary")
    Set dict表2 = CreateObject("Scripting.Dictionary")

    ' 提示用户选择表1范围
    On Error Resume Next
    Set rng表1 = Application.InputBox("请选择表1的对比数据范围（包含标题行）", Type:=8)
    If rng表1 Is Nothing Then Exit Sub
    On Error GoTo 0

    ' 提示用户选择表2范围
    On Error Resume Next
    Set rng表2 = Application.InputBox("请选择表2的对比数据范围（包含标题行）", Type:=8)
    If rng表2 Is Nothing Then Exit Sub
    On Error GoTo 0

    ' 将表1数据存入字典，以第一列为Key，其他列用数组存储为Value
    Dim r As Range
    For Each r In rng表1.Rows
        If r.Row > rng表1.Cells(1, 1).Row Then ' 忽略标题行
            If Not dict表1.exists(r.Cells(1, 1).Value) Then
                dict表1.Add r.Cells(1, 1).Value, Application.Transpose(Application.Transpose(r.Cells.Value))
            End If
        End If
    Next r

    ' 将表2数据存入字典，以第一列为Key，其他列用数组存储为Value
    For Each r In rng表2.Rows
        If r.Row > rng表2.Cells(1, 1).Row Then ' 忽略标题行
            If Not dict表2.exists(r.Cells(1, 1).Value) Then
                dict表2.Add r.Cells(1, 1).Value, Application.Transpose(Application.Transpose(r.Cells.Value))
            End If
        End If
    Next r

    ' 创建新的工作表存放校准结果
    Set ws结果 = ThisWorkbook.Sheets.Add
    ws结果.Name = "校准结果"
    
    ' 写入结果标题
    ws结果.Cells(1, 1).Value = "唯一标识"
    ws结果.Cells(1, 2).Value = "表1数据"
    ws结果.Cells(1, 3).Value = "表2数据"
    ws结果.Cells(1, 4).Value = "校准结果"

    Dim i As Long
    i = 2 ' 从第二行开始写入校准结果

    ' 遍历表1，查找表2中是否存在
    Dim key As Variant
    For Each key In dict表1.keys
        ws结果.Cells(i, 1).Value = key
        ws结果.Cells(i, 2).Value = Join(dict表1(key), ", ")

        If dict表2.exists(key) Then
            ws结果.Cells(i, 3).Value = Join(dict表2(key), ", ")
            If Join(dict表1(key), ", ") = Join(dict表2(key), ", ") Then
                ws结果.Cells(i, 4).Value = "一致"
            Else
                ws结果.Cells(i, 4).Value = "不一致"
            End If
        Else
            ws结果.Cells(i, 3).Value = "表2中不存在"
            ws结果.Cells(i, 4).Value = "缺失数据"
        End If
        i = i + 1
    Next key

    ' 遍历表2，查找表1中是否存在但未处理
    For Each key In dict表2.keys
        If Not dict表1.exists(key) Then
            ws结果.Cells(i, 1).Value = key
            ws结果.Cells(i, 2).Value = "表1中不存在"
            ws结果.Cells(i, 3).Value = Join(dict表2(key), ", ")
            ws结果.Cells(i, 4).Value = "缺失数据"
            i = i + 1
        End If
    Next key

    ' 自动调整列宽
    ws结果.Columns.AutoFit

    MsgBox "差异校准完成！结果已生成在工作表“校准结果”中。", vbInformation

End Sub
```