从多张纸上查找单元格总和的过程

时间:2014-11-17 18:35:55

标签: excel vba excel-vba

我导入Excel的大约100个文本文件(使用2010年)。每张纸在第I列中都有一个我需要总计的值;值的行有所不同,但在所有情况下都是最后一行。

因为我无法想出一种合适的方法来编写一种方法来对这些值进行求和,而基本上没有"复制"数据,我想我是一个我想去的过程,需要纠正/帮助,如果这是不正确的。

我想找到第一列(我的范围)中的最后一行,并将其放在一个新工作表上,创建一个列表;这将在新页面的B列中。 A列必须说明数据的标题。

此时我将对该值求和。

到目前为止,我一无所获。我尝试编写下面的代码,这似乎给了我zilch:

Sub Scuba()

Dim ws As worksheet
Dim rng As Object
Dim numrows As Integer

numrows = Rows.Count
Set rng = .Range(.Cells(1, 9), .Cells(numrows, 9))

worksheet.Add.Name = Tally

For Each ws In Workbook

Sheets("Tally").Range(xlEnd.Row + 1, 1).Value = ActiveSheet.Name
Sheets("Tally").Range(xlEnd.Row + 1, 2).Value = rng.xlEnd

Next

End Sub

所有数据的格式均为:

20141103-20141107

Date  In    Out   Listing
1103  0710  1710  1000 - 1000
1104  0715  1800  1045 - 2045
1105  0715  1800  1045 - 3130
1106  0700  1745  1045 - 4215
1107  0700  1015  0315 - 4530

描绘的空格表示新单元格。在这个例子中,我想要保留的值和总数将是4530的最终列表。

任何帮助都将不胜感激。


编辑:

由于我在选择列中的最后一个单元格时遇到问题,或许我可以以列表方式将每张表格的最后一行放到新表格中。这至少可以使整个项目的管理变得更容易(文本文件的数量因人而异,因为它们已经为时间记录程序投入了多少工作;我将这样做对于多个人来说,在X期间工作的小时数。) 我仍然想要从A列中取出它的表格,开始复制B栏中的最后一行。

随着这一进展,我会发布更多信息。感谢到目前为止的所有输入。

2 个答案:

答案 0 :(得分:1)

此代码将创建一个新工作表" Tally" (除非它已经存在)并添加每个工作表的名称和最后时间。我已成功测试了以下内容。

编辑:此代码正在测试工作

   Sub Scuba()
    Dim ws As Worksheet
    Dim RunSub As Long
    Dim LastRow As Long
    Dim NameTest As String
    Dim NewWS As Worksheet

    On Error Resume Next

    'Creates Tally sheet if it doesn't exist
    NameTest = Worksheets("Tally").Name
    If Err.Number = 0 Then
    Else
        Err.Clear
        Set NewWS = ActiveWorkbook.Sheets.Add(Before:=ActiveWorkbook.Sheets(1))
            NewWS.Name = "Tally"
    End If

    For Each ws In ActiveWorkbook.Worksheets
        If Not ws.Name = "Tally" Then
            LastRow = ws.Range("I" & Rows.Count).End(xlUp).Row
            DestRow = Sheets("Tally").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Tally").Range("A" & DestRow).Value = ws.Name
            Sheets("Tally").Range("B" & DestRow).Value = ws.Range("I" & LastRow).Value
        Else
        End If
    Next ws

    DestRow = Sheets("Tally").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Tally").Range("A" & DestRow).Value = "Grand Total"
    Sheets("Tally").Range("B" & DestRow).Value = Application.Sum(Range("B1:B" & DestRow - 1))

MsgBox "Done"

End Sub

答案 1 :(得分:1)

我希望这会有所帮助。

Sub Scuba()

  Dim ws As Worksheet, wsTally As Worksheet
  Dim rng As Object
  Dim numrows As Integer

  Set wsTally = Worksheets.Add

  'if there is already a sheet named Tally, then this will result in wsTally being called Sheet6 or whatever...
  On Error Resume Next
  wsTally.Name = "Tally"
  On Error GoTo 0

  Dim i As Long
  i = 1

  With wsTally
    For Each ws In ActiveWorkbook
      i = i + 1
      .Range(i + 1, 1).value = ws.Name
      .Range(i + 1, 2).value = LastValInRow(9, ws).value
    Next ws
  End With

End Sub

Function LastValInRow(Column As Long, WrkSht As Worksheet) As Range
  Dim c As Range
  Set c = WrkSht.Columns(Column)

  'get the last cell excel thinks is uesd
  Dim LstUsed As Long
  LstUsed = c.Rows.Count + 1
  'add one, just in case excel is correct

  'get the actual last used cell
  Dim r As Range
  ' .End(xlUp) is equivalent to Ctrl+Up
  Set r = c.Cells(LstUsed, 1).End(xlUp)

  Set LastValInRow = r
End Function