尝试创建创建新Excel工作表并将数据复制到工作表的循环

时间:2014-01-02 16:49:45

标签: excel excel-vba loops vba

我有一个循环填充我的excel工作簿,当前工作表包含在我的程序运行期间计算的数据。我的循环应该检查当前年份选项卡是否存在,如果它确实应该写入该表。如果没有,它应该创建另一张表,其中当前年份作为工作表的名称,并复制在新创建的工作表之前的工作表的A1-A65中的标题标题。它完成了当前年份表的工作(如果它已经存在),但不会创建当前年份的新工作表,如果当前年份表不存在则复制单元格。我已经包含了循环和几行后,看看是否有人可以帮助我发现或纠正错误

   Dim excel_app As Excel.Application
    Dim workbook As Excel.Workbook
    Dim sheet_name As String
    Dim sheet As Excel.Worksheet

    Dim exeDir As New IO.FileInfo(Reflection.Assembly.GetExecutingAssembly.FullName)
    Dim xlPath = IO.Path.Combine(exeDir.DirectoryName, "Records.xlsx")

    ' Get the Excel application object.
    excel_app = New Excel.Application

    ' Make Excel visible (optional).
    excel_app.Visible = False

    ' Open the workbook.
    workbook = excel_app.Workbooks.Open(xlPath)


    'Under Construction, trying to check if current year tab exists, if not creating it
    Dim i As Integer
    Dim blnsheet As Boolean = False
    Dim yearstamp As String = _
    DateTime.Now.ToString("yyyy")

    Dim datestamp As String = _
            DateTime.Now.ToString("MMMM yyyy")

    With workbook
        For i = 1 To .Sheets.Count
            If .Sheets(i).name = yearstamp Then
                blnsheet = True
                Exit For
            End If
        Next i

        If blnsheet = False Then
            .Sheets.Add()
            With .ActiveSheet
                .name = yearstamp
                .Range("A1:A65") = .Sheets(i - 1).Range("A1:A65")
            End With
        End If
    End With

    'End of Sheet loop

    sheet_name = yearstamp
    sheet = excel_app.Worksheets(sheet_name)

    Dim ColumnCount As Long
    ColumnCount = sheet.Range("A1").CurrentRegion.Columns.Count

    For m As Integer = 0 To ColumnCount
        If sheet.Range("A1").Offset(0, m).Value = datestamp Then
            ColumnCount = m
            Exit For
        End If
    Next m

    'End Construction


    With sheet.Range("A1")
        .Offset(0, ColumnCount).Value = datestamp
        .Offset(1, ColumnCount).Value = "$" & FormatNumber(GlobalVariables.totalincome, 2)
        .Offset(2, ColumnCount).Value = "$" & FormatNumber(totalexpenses, 2)
        .Offset(3, ColumnCount).Value = "$" & FormatNumber(GlobalVariables.cellphone, 2)
        .Offset(4, ColumnCount).Value = "$" & FormatNumber(GlobalVariables.carinsurance, 2)
        .Offset(5, ColumnCount).Value = "$" & FormatNumber(GlobalVariables.healthinsurance, 2)
        .Offset(6, ColumnCount).Value = "$" & FormatNumber(GlobalVariables.therapysessions, 2)
        .Offset(7, ColumnCount).Value = "$" & FormatNumber(GlobalVariables.drappointments, 2)
        .Offset(8, ColumnCount).Value = "$" & FormatNumber(GlobalVariables.medications, 2)
        .Offset(9, ColumnCount).Value = GlobalVariables.med1name & " $" & FormatNumber(GlobalVariables.med1, 2)
        .Offset(10, ColumnCount).Value = GlobalVariables.med2name & " $" & FormatNumber(GlobalVariables.med2, 2)
        .Offset(11, ColumnCount).Value = GlobalVariables.med3name & " $" & FormatNumber(GlobalVariables.med3, 2)
        .Offset(12, ColumnCount).Value = GlobalVariables.med4name & " $" & FormatNumber(GlobalVariables.med4, 2)
        .Offset(13, ColumnCount).Value = GlobalVariables.med5name & " $" & FormatNumber(GlobalVariables.med5, 2)
        .Offset(14, ColumnCount).Value = GlobalVariables.med6name & " $" & FormatNumber(GlobalVariables.med6, 2)
        .Offset(15, ColumnCount).Value = GlobalVariables.med7name & " $" & FormatNumber(GlobalVariables.med7, 2)
        .Offset(16, ColumnCount).Value = GlobalVariables.med8name & " $" & FormatNumber(GlobalVariables.med8, 2)

修改以添加最近进度/失败的尝试

  'Under Construction, trying to check if current year tab exists, if not creating it
    Dim blnsheet As Boolean = False

    With workbook
        If .Item(yearstamp) = True Then
            blnsheet = True
        Else : blnsheet = False
        End If

        If blnsheet = False Then
            .Sheets.Add()
            .ActiveSheet.Name = yearstamp
            .ActiveSheet.Range("A1:A65") = .Sheets(yearstamp - 1).Range("A1:A65")
        End If
    End With

1 个答案:

答案 0 :(得分:1)

我认为,您可以通过按名称查找工作表完全摆脱循环。 Item属性将接受表示工作表名称的字符串。

请参阅Sheets.Item property

  

索引
  输入:System.Object
  必需对象。对象的名称或索引号。

这将返回Worksheet个对象。您可以测试返回值是否为Nothing以确定它是否存在:

Dim l_worksheets = workbook.Worksheets
Dim l_worksheet = l_worksheets("2013")
Dim l_worksheetExists = l_worksheet Is Not Nothing

你可能还没有注意到的一个问题(也许你有,而且你关心更紧迫的问题)是你的代码执行完毕后Excel没有正确退出,即使你正在调用Quit。如果你还没有注意到,那你就会。这是因为您正在创建对象的引用,但在完成后不会清除它们。我在你的代码中看到了几个例子,但具体指出一个例子:

        For i = 1 To .Sheets.Count

您永远不会清理Sheets COM对象,因此它会在内存中挂起。 (因为它是一个COM对象,所以不能进行垃圾回收。)

请参阅Never use 2 dots with com objects