Question

嘿，我有一个无法解决的小问题...我不是第一个发现此问题的人，但是现有的解决方案都无法在我的代码上工作。所以我被困住了...问题是我的代码运行得比函数可以执行的快。

我的代码将相同类型的所有工作表一起添加到新工作表中。为了表明每个文件在新工作表中的显示时间，我想将最后一行的内部更改为另一种颜色。我的代码现在可以执行此操作，但只能在调试模式下进行...而且我不知道如何“慢下来”，这样我才能使用我的宏。 iv尝试了一个延迟函数，DoEvent并添加了一个计时器，但没有一个起作用。。。非常感谢您提供一些有关如何解决此问题的提示，或者是否有更好的方法来做到这一点。谢谢！

    Sub MergeSheets()
        Dim WorkSheetSource As Worksheet
        Dim WorkSheetDestination As Worksheet
        Dim RangeSource As Range
        Dim RangeDestination As Range
        Dim lngLastCol As Long
        Dim lngSourceLastRow As Long
        Dim lngDestinationLastRow As Long
        Dim SheetName As String
        Dim SkipSheets As String

        'Set references up-front
        Set WorkSheetDestination = ThisWorkbook.Worksheets("Import")
        lngDestinationLastRow = LastOccupiedRowNum(WorkSheetDestination) '<~ defined below (and in Toolbelt)!
        lngLastCol = LastOccupiedColNum(WorkSheetDestination) '<~ defined below (and in Toolbelt)!

        'Set the initial destination range
        Set RangeDestination = WorkSheetDestination.Cells(lngDestinationLastRow + 1, 1)
                                    ' (lngDestinationLastRow + 2) = what row to start adding on, 1 = start from column
        ' Skip this sheets          ' the 2 makes a blank row between sheeeeets
        SkipSheets = ("Import, Cover sheet, Control, Column description, Charts description")

        'Loop through all sheets
        For Each WorkSheetSource In ThisWorkbook.Worksheets ' Here i coud add a function where i can choose my Sheets?
            DoEvents
            'Make sure we skip the "Import" destination sheet!
            If InStr(1, SkipSheets & ",", WorkSheetSource.Name & ",", vbTextCompare) = 0 Then

                ' Skip all Charts sheets
                If InStr(WorkSheetSource.Name, "Status") Then

                    'Identify the last occupied row on this sheet
                    lngSourceLastRow = LastOccupiedRowNum(WorkSheetSource)

                    'Store the source data then copy it to the destination range
                    With WorkSheetSource
                        Set RangeSource = .Range(.Cells(3, 1), .Cells(lngSourceLastRow, lngLastCol)) ' 3 = what start row , 2 = how many columns
                            RangeSource.Copy Destination:=RangeDestination

                    End With

                    'Redefine the destination range now that new data has been added
                    LongDestinationLastRow = LastOccupiedRowNum(WorkSheetDestination)
                    Set RangeDestination = WorkSheetDestination.Cells(LongDestinationLastRow + 1, 1)
                    'LongDestinationLastRow.EntireRow.Interior.ColorIndex = 15
                End If

                ' Find last row and give it colour
                'Range("A" & Rows.Count).End(xlUp).Select
                'ActiveCell.EntireRow.Interior.ColorIndex = 15
                ' don´t work... only in debugmode

            End If

' **** Here the code works in debug mode but not in macro!*****
            ' Find last row and give it colour
            Range("A" & Rows.Count).End(xlUp).Select
            ActiveCell.EntireRow.Interior.ColorIndex = 15

'*************************************************************

        Next WorkSheetSource
        MsgBox "Done"
    End Sub

VBA代码在调试模式下工作，但无法作为宏运行

0 个答案: