excel - 复制粘贴宏正在诱导 'grouped' -工作表功能？

Question

我收到一个我无法弄清楚的错误:

在我运行下面的宏之后，两个特定的字符串值被粘贴到所有工作表中的相同两个单元格中，尽管我确信工作表没有分组或不包含它们自己的单独代码。具体来说，项目“B12”和“B25”粘贴在所有页面上的相同单元格(A29 和 A30)(参见代码)。 “B12”和“B25”与单元格位置无关，只是我的应用程序唯一的标识符。它们是从一张纸复制+粘贴到另一张纸上的值。如果它是代码中的复制+粘贴错误，那么我希望所有项目都有相同的错误，因为每个工作表都调用了“算法”子例程。

有时，在没有执行宏的情况下也会发生这种情况。当我尝试将我的工作簿编辑回粘贴字段之前的状态时(通过单击每个单元格并输入曾经存在的内容)，它仍然会对所有工作表进行这些更改，即使我确定它们没有分组或运行代码。

' Title: DSR AutoFill Macro

Sub autofill_DSR()

' Variable Declarations:

Dim x_count As Long
Dim n As Long
Dim item_a As String
Dim item_b As String
'Dim test_string As String

' Variable Initializations:

x_count = 0
Process_Control_NumRows = 15
Electrical_NumRows = 8
Environmental1_NumRows = 17
Env2_Regulatory_NumRows = 14
FIRE_NumRows = 15
Human_NumRows = 16
Industrial_Hygiene_NumRows = 16
Maintenance_Reliability_NumRows = 10
Pressure_Vacuum_NumRows = 16
Rotating_n_Mechanical_NumRows = 11
Facility_Siting_n_Security_NumRows = 10
Process_Safety_Documentation_NumRows = 3
Temperature_Reaction_Flow_NumRows = 18
Valve_Piping_NumRows = 22
Quality_NumRows = 10
Product_Stewardship_NumRows = 20
fourB_Items_NumRows = 28
'test_string = "NN"

' Main Data Transfer Code:

Sheets(Array("SUMMARY P.1", "SUMMARY P.2", "Process Control", _
"Electrical", "Environmental1", "Env.2 - Regulatory", "FIRE", _
"Human", "Industrial Hygiene", "Maintenance_Reliability", _
"Pressure_Vacuum", "Rotating & Mechanical", _
"Facility Siting & Security", "Process Safety Documentation", _
"Temperature-Reaction-Flow", "Valve-Piping", "Quality", _
"Product Stewardship", "4B ITEMS")).Select              'Create Array of all Sheets

'Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select     ' For testing

' Process Control Sheet:

    For n = 0 To (Process_Control_NumRows - 1)  'Cycle 16 times for each
                                                'item row in process controls tab
        Sheets("Process Control").Activate      'Choose specific sheet
        Range("D15").Select                     'Choose starting cell of "Yes" column

        Call Module2.algorithm(n, x_count)      'Call on subroutine (see algorithm code)

    Next n                                      'increment index to account for offset

' Electrical Sheet:

    For n = 0 To (Electrical_NumRows - 1)

        Sheets("Electrical").Activate
        Range("D15").Select

        Call Module2.algorithm(n, x_count)

        If (x_count > 21) Then                  'Abort autofill if too many items to hold
            Sheets("SUMMARY P.1").Activate      'on both summary pages put together (21 count)
            GoTo TooMany_Xs
        End If

    Next n

这对所有的工作表都继续......

' 4B ITEMS Sheet:

    For n = 0 To (fourB_Items_NumRows - 1)

        Sheets("4B ITEMS").Activate
        Range("D16").Select         ' NOTE: Starting cell is "D16"

        Call Module2.algorithm(n, x_count)

        If (x_count > 21) Then
            Sheets("SUMMARY P.1").Activate
            GoTo TooMany_Xs
        End If

    Next n

If (x_count > 5) Then               'Bring user back to last logged sheet

    Sheets("SUMMARY P.2").Activate

Else

    Sheets("SUMMARY P.1").Activate

End If

TooMany_Xs:
 If Err.Number <> 0 Then
    Msg = "you put more than 21 Items on the Summary Pages." & Chr(13) & _
        "Consider editing your DSR or taking some other action."
    MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
 End If

End Sub

然后以下宏位于 Module2 中:

Sub algorithm(n As Long, x_count As Long)

        'If an "x" or "X" is marked in the "Yes" column,
        'at descending cells down the column offset by the for loop index, n

        If (ActiveCell.Offset(n, 0) = "x" Or ActiveCell.Offset(n, 0) = "X") Then

            item_a = ActiveCell.Offset(n, -3).Value     ' Store Letter value
            item_a = Replace(item_a, "(", "")           ' Get rid of "(", ")", and " " (space)
            item_a = Replace(item_a, ")", "")           ' characters that are grabbed
            item_a = Replace(item_a, " ", "")

            item_b = ActiveCell.Offset(n, -2).Value     ' Store number value
            item_b = Replace(item_b, "(", "")           ' Get rid of "(", ")", and " " (space)
            item_b = Replace(item_b, ")", "")           ' characters that are grabbed
            item_b = Replace(item_b, " ", "")

            x_count = x_count + 1                       ' increment the total x count

            If (x_count > 5) Then                       ' If there are more than 5 "x" marks,

                Sheets("SUMMARY P.2").Activate          ' then continue to log in SUMMARY P.2
                Range("A18").Select                     ' Choose "Item" column, first cell
                ActiveCell.Offset((x_count - 6), 0).Value = (item_a & item_b)

                'Insert cocatenated value of item_a and item_b
                '(for example "A" & "1" = "A1")
                'at the cells under the "Item" column, indexed by x_count

            Else                                        ' If there are less than 5 "x" marks,

                Sheets("SUMMARY P.1").Activate          ' log in SUMMARY P.1
                Range("A25").Select
                ActiveCell.Offset((x_count - 1), 0).Value = (item_a & item_b)

            End If

        End If

结束子

Answer 1

通过选择数组中的所有工作表，您可以对它们进行分组，并且您写入任何工作表中的单元格的任何内容都将写入所有工作表。

这是罪魁祸首:

Sheets(Array("SUMMARY P.1", "SUMMARY P.2", "Process Control", _
"Electrical", "Environmental1", "Env.2 - Regulatory", "FIRE", _
"Human", "Industrial Hygiene", "Maintenance_Reliability", _
"Pressure_Vacuum", "Rotating & Mechanical", _
"Facility Siting & Security", "Process Safety Documentation", _
"Temperature-Reaction-Flow", "Valve-Piping", "Quality", _
"Product Stewardship", "4B ITEMS")).Select

即使您发布的代码尚未运行，您的问题也会发生这一事实让我认为在您选择所有工作表后还有其他事情发生。

请注意，选择和激活是一个非常糟糕的主意。为要使用的对象声明变量并以这种方式与它们交互，而不是选择它们。

这是一个快速示例，说明如何循环浏览工作簿中的所有工作表并在不选择或激活的情况下对其进行修改。您可以修改代码以使用此模式:

Sub LoopThroughAllSheets()
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook

    For Each ws In wb.Sheets
        ws.Range("D15").Value = ws.Name
    Next ws
End Sub

请阅读以下内容以帮助您开始编写更简洁、更高效的 VBA 代码:

Beginning VBA: Select and Activate

Excel macro - Avoid using Select