我收到一个我无法弄清楚的错误：
在我运行下面的宏之后，两个特定的字符串值被粘贴到所有工作表中的相同的两个单元格中，尽管我确信这些工作表没有分组或者不包含他们自己的单个代码。具体地，项目“B12”和“B25”被粘贴在相同单元（A29和A30）的所有页面上（参见代码）。 “B12”和“B25”与单元格位置无关，但只是我的应用程序独有的标识符。它们是从一个工作表复制+粘贴到另一个工作表的值。如果它是代码中的复制+粘贴错误，那么我希望所有项目都有相同的错误，因为每个工作表都会调用“algorithm”子程序。
有时，这也会在不执行宏的情况下发生。当我尝试将我的工作簿编辑回到字段粘贴之前的状态（通过单击每个单元格并键入以前的内容），它仍会对所有工作表进行更改，即使我确定它们未分组或运行代码。
' 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
End Sub
答案 0 :(得分：3)
通过选择阵列中的所有工作表，您正在对它们进行分组，并且您在任何工作表中写入单元格的任何内容都将写入所有工作表。
这是罪魁祸首：
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代码：
答案 1 :(得分：0)
Sheets(Array("SUMMARY P.1", "SUMMARY P.2", "Process Control", _
"Electrical", "Environmental1", "Env.2 - Regulatory", "FIRE", _
...
"Product Stewardship", "4B ITEMS")).Select
正在对所有这些工作表进行分组。在某些时候，您需要通过选择单个工作表来取消组合：
Worksheets("Whatever").Select
您还应该检查您的代码，以检查是否真的需要对工作表进行分组。