复制粘贴宏是诱导“分组” - 工作表功能? [英] Copy Paste macro is inducing 'grouped'-worksheet functionality?
问题描述
在下面运行宏之后,将两个特定的字符串值粘贴到ALL中的相同的两个单元格中尽管我确信床单不分组,也不包含自己的单独代码。具体地,项目B12和B25被粘贴在相同单元格(A29和A30)的所有页面上(见代码)。 B12和B25与单元格位置无关,只是我应用程序唯一的标识符。它们是从一张纸复制+粘贴到另一张纸的值。如果它是代码中的一个复制+粘贴错误,那么我希望所有的项目都有相同的错误,因为每个工作表都调用算法子程序。
有时,这也会发生在没有执行宏的情况下。当我尝试编辑我的工作簿回到它是如何粘贴之前(通过点击每个单元格,并键入以前在那里),它仍然使这些更改所有的工作表,即使我确信他们没有分组或运行代码。
'标题:DSR自动填充宏
Sub autofill_DSR()
'变量声明:
Dim x_count As Long
Dim n As Long
Dim item_a As String
Dim item_b As String
'Dim test_string As String
'变量初始化:
x_count = 0
Process_Control_NumRows = 15
Electrical_NumRows = 8
Environment1_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
Tem perature_Reaction_Flow_NumRows = 18
Valve_Piping_NumRows = 22
Quality_NumRows = 10
Product_Stewardship_NumRows = 20
fourB_Items_NumRows = 28
'test_string =NN
'主要数据传输代码:
表格(Array(SUMMARY P.1,SUMMARY P.2,Process Control,_
Electrical,Environmental1, Env.2 - 监管,FIRE,_
人,工业卫生,维护可靠性,_
Pressure_Vacuum,旋转&机械,_
设施选址安全,过程安全文件,_
温度反应流程,阀门管道,质量,_
产品管理,4B ITEMS)) '创建所有表格的数组
'表格(Array(Sheet1,Sheet2,Sheet3))。选择'用于测试
'过程控制表:
对于n = 0 To(Process_Control_NumRows - 1)'在过程控制选项卡
表单(过程控制)中循环16次每个
'项目行激活'选择特定表
范围(D15)。选择选择开始单元格是列
调用Module2.algorithm(n,x_count)'调用子程序(请参阅算法代码)
下一个n'增量索引以计算偏移
'电表:
对于n = 0 To(Electrical_NumRows - 1)
床单(电气) vate
Range(D15)。选择
调用Module2.algorithm(n,x_count)
如果(x_count> 21)然后'中止自动填充如果太多的项目要持有
表(SUMMARY P.1)。激活'在两个总结页面放在一起(21计数)
GoTo TooMany_Xs
结束If
下一页n
b
'4B项目表:
对于n = 0至(fourB_Items_NumRows - 1)
表格(4B ITEMS)激活
范围(D16)选择'注意:启动单元格是D16
调用Module2.algorithm(n,x_count)
如果(x_count> 21)然后
表单(SUMMARY P.1)。激活
GoTo TooMany_Xs
如果
下一步n
如果(x_count> 5)然后'将用户带回上一个记录表
表(SUMMARY P.2)。激活
Else
表格(SUMMARY P.1)。激活
如果
TooMany_Xs:
如果Err.Number<> 0然后
Msg =您在摘要页面上放置了超过21个项目。 &安培; Chr(13)& _
考虑编辑您的DSR或采取其他行动。
MsgBox Msg,,Error,Err.HelpFile,Err.HelpContext
End If
End Sub
然后,以下宏位于Module2中:
子算法(n As Long,x_count As Long)
'如果在是列中标记了x或X,则
'在列偏移量下降单元格for循环索引,n
If(ActiveCell.Offset(n,0)=x或ActiveCell.Offset(n,0)=X)然后
item_a = ActiveCell.Offset(n,-3).Value'Store Letter value
item_a = Replace(item_a,(,)'摆脱(,)和(空格)
item_a =替换(item_a,),)'被抓取的字符
item_a =替换(item_a,,)
item_b = ActiveCell.Offset(n,-2).Value'存储号码值
item_b =替换(item_b,(,)'摆脱( ,)和(空格)
item_b =替换(item_b,),)'被抓取的字符
item_b =替换(item_b,,)
x_count = x_count + 1'增加总计数
如果(x_count> 5)然后'如果有超过5个x标记,
表(SUMMARY P.2)。激活'然后继续登录SUMMARY P.2
范围A18)。选择选择项目列,第一个单元格
ActiveCell.Offset((x_count - 6),0).Value =(item_a& item_b)
'插入item_a和item_b
'(例如A&1=A1)的并发值,
'在Item列下的单元格,由x_count
否则如果少于5x的标记,
表单(SUMMARY P.1)。激活登录摘要P.1
范围(A25 )。选择
ActiveCell.Offset((x_count - 1),0).Value =(item_a& item_b)
End If
End If
结束子
通过选择数组中的所有工作表,您将其分组,并且任何您写入任何工作表中的单元格的内容请写入所有表格。
这是罪魁祸首:
表格(Array(SUMMARY P.1,SUMMARY P.2,Process Control,_
Electrical,Environmental1,Env.2 - Regulatory,FIRE,_
人,工业卫生,维护可靠性,_
Pressure_Vacuum,旋转&机械,_
设施选址安全,过程安全文件,_
温度反应流程,阀门管道,质量,_
产品管理,4B ITEMS))
即使您发布的代码尚未运行,您的问题仍然发生,因此我认为在您选择所有表格之后,还有其他事情。
请注意,选择和激活是一个非常糟糕的主意。为要使用的对象声明变量并以这种方式与他们进行交互,而不是选择它们。
以下是一个简单的例子,说明如何循环遍历工作簿中的所有工作表,并在不选择或激活的情况下进行修改您可以修改代码以使用此模式:
Sub LoopThroughAllSheets()
Dim wb As Workbook
Dim ws As Worksheet
设置wb = ThisWorkbook
对于每个ws在wb.Sheets
ws.Range(D15)。值= ws.Name
下一个ws
结束Sub
请阅读以下内容,让您开始撰写更干净,更高效的VBA代码:
I am getting an error I can't figure out:
After I run the macro below, two certain string values are pasted into the same two cells in ALL sheets, although I am sure that the sheets are not grouped or do not contain individual code of their own. Specifically, the items "B12" and "B25" are pasted on all pages at the same cells (A29 and A30) (See code). "B12" and "B25" have nothing to do with a cell location but are just identifiers unique to my application. They are values which are copied+pasted from one sheet into another. If it is a copy+paste error in the code, then I would expect all the items to have the same error because the "algorithm" subroutine is called for every sheet.
Sometimes, this also occurs without execution of the macro. And when I try to edit my workbook back to how it was before fields were pasted over (by clicking each cell and typing what used to be there), it still makes those changes to all sheets, even though I am sure they are not grouped or running code.
' 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
This continues for all the sheets...
' 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
And then this following macro is located in 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
By selecting all the sheets in your array, you are grouping them, and anything you write to a cell in any sheet will be written to all sheets.
This is the culprit:
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
The fact that your issue occurs even if the code you posted hasn't been run makes me think there is something else going on after you've selected all the sheets.
Note that selecting and activating are a really bad idea. Declare variables for the objects you want to work with and interact with them that way instead of selecting them.
Here is a quick example of how you can loop through all the sheets in a workbook and modify them without selecting or activating. You can modify your code to use this pattern:
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
Please read the following to get you started on writing cleaner, more efficient VBA code:
这篇关于复制粘贴宏是诱导“分组” - 工作表功能?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!