如何将一个工作薄中的每个sheet相同单元格相加呢

fishbird

hahahahaha

我会哭的像英雄

哈啥哟

军生

注:下段代码求解文件扩展名,以便把xls文件和其他文件分离出来.
Public Function SplitPath(FullPath, ResultFlag As Integer) As String '
Dim SplitPos As Integer, DotPos As Integer
SplitPos = InStrRev(FullPath, "\")
DotPos = InStrRev(FullPath, ".")
Select Case ResultFlag
    Case 0
        SplitPath = Left(FullPath, SplitPos - 1)
    Case 1
        If DotPos = 0 Then DotPos = Len(FullPath) + 1
        SplitPath = Mid(FullPath, SplitPos + 1, DotPos - SplitPos - 1)
    Case 2
        If DotPos = 0 Then DotPos = Len(FullPath)
        SplitPath = Mid(FullPath, DotPos + 1)
    Case Else
        Err.Raise vbObjectError + 1, "SplitPath Function", "Invalid Parameter!"
End Select
End Function
-------------------------------------------------------------------------------------------------------
注:下面代码创建交错数组记录参与求和的工作表内容,并对数组结果求和.
Sub total_1()
    Dim fn, fld, strPath$
    Dim obj As Object
    Dim Sh As Worksheet
    Dim DB As ADODB.Connection
    Dim FileName  As String
    Dim TableRst As ADODB.Recordset '定义表
    Dim ColumnRst As New ADODB.Recordset '定义字段
    Dim rs As Recordset '定义记录

    Set DB = New ADODB.Connection
    Set rs = New Recordset
    strPath = ThisWorkbook.Path
    Set obj = CreateObject("Scripting.FileSystemObject")
    Set fld = obj.GetFolder(strPath)
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    For Each fn In fld.Files
    On Error Resume Next
    If SplitPath(fn.Name, 2) = "xls" And fn.Name <> ThisWorkbook.Name Then '筛选后缀为.xls的文件
    i = i + 1 '统计工作簿数量
    If i > 1 Then '假设参与汇总求和的工作簿的工作表数量都一样,故只需要测试一个工作簿的工作表数.
    GoTo 1
    Else
     FileName = ThisWorkbook.Path & "\" & fn.Name
    DB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;  Data Source=" & FileName & ";Extended Properties='Excel 8.0;IMEX=1;HDR=no'"
  
    Set TableRst = DB.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "Table"))
   
    TableRst.MoveFirst
    While Not TableRst.EOF            '遍历每个表
    'Table = TableRst!TABLE_NAME   'Table 变量 也可 TableRst!TABLE_NAME.Value 也可 TableRst("TABLE_NAME").Value
    j = j + 1 '统计单个工作簿工作表数量
    TableRst.MoveNext
    Wend
   
1
    End If
    End If
    Next
    DB.Close
    'Set TableRst = Nothing: Set DB = Nothing
     ReDim s(0 To i - 1, 0 To j - 1) '定义二维数组,表示所处工作簿及工作表位置
   
   
    For Each fn In fld.Files
    On Error Resume Next
    If SplitPath(fn.Name, 2) = "xls" And fn.Name <> ThisWorkbook.Name Then '筛选后缀为.xls的文件
    u = u + 1 '计量工作簿所在文件夹的顺序号
    FileName = ThisWorkbook.Path & "\" & fn.Name
   
   
    DB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;  Data Source=" & FileName & ";Extended Properties='Excel 8.0;IMEX=1;HDR=no'"
    Set TableRst = DB.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "Table"))
     v=0 '每访问一工作簿初始化工作表顺序初始值为0
    TableRst.MoveFirst
    While Not TableRst.EOF            '遍历每个表
    Table = TableRst!TABLE_NAME   'Table 变量 也可 TableRst!TABLE_NAME.Value 也可 TableRst("TABLE_NAME").Value
    v = v + 1 '计量工作表所在工作簿顺序号
    If rs.State = adStateOpen Then rs.Close
    rs.Open "Select * from [" & Table & "]", DB, adOpenStatic, adLockOptimistic   'adOpenDynamic
    m = rs.Fields.Count '取得工作表的字段数
    If Not rs.EOF Then
    rs.MoveLast
    n = rs.RecordCount '取得工作表的记录行数
    Else
   'Response.Write "没有记录"
    End If
     ReDim arr(0 To m - 1, 0 To n - 1) '每访问一工作表,定义数组arr记录工作表单元格值
     For fieldcount = 0 To m - 1
     l = 0
     rs.MoveFirst
     Do While Not rs.EOF
         l = l + 1
      'MsgBox l

     If IsNull(rs.Fields(fieldcount)) Then
     arr(fieldcount, l - 1) = 0
     Else
     arr(fieldcount, l - 1) = rs.Fields(fieldcount)
     End If
     rs.MoveNext
     Loop

    Next
    s(u - 1, v - 1) = arr '交错数组赋值
   
   TableRst.MoveNext
    Wend
    End If
db.close
    Next fn
    DB.Close
    Set rs = Nothing: Set DB = Nothing
    For Each Sh In ThisWorkbook.Worksheets
    Sh.Cells.Clear
    Next
    For v = 0 To j - 1
    For u = 0 To i - 1
    For x = 0 To UBound(s(u, v), 1)
    For y = 0 To UBound(s(u, v), 2)
    If IsNumeric(s(u, v)(x, y)) Then
    ThisWorkbook.Worksheets(v + 1).Cells(y + 1, x + 1) = ThisWorkbook.Worksheets(v + 1).Cells(y + 1, x + 1) + s(u, v)(x, y)
    Else
    ThisWorkbook.Worksheets(v + 1).Cells(y + 1, x + 1) = s(0, v)(x, y) '如果不为数值,则本工作簿工作表中单元格为第一张工作簿对应单元格数值,往往为文本性质单元格.
    End If
    Next
    Next
    Next
    Next
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub

helen_k1

第一个问题合并计算就可以，非常方便。
第二个问题，右键点sheet的名字，出来一个移动或复制工作表，按其中的提示就可以。