vba 用于在 Excel 中为其他列中的信息匹配的行合并单元格的宏
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20547189/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Macro to merge cells in Excel for rows in which information in other columns matches
提问by mustelid
I am a programming novice. I taught myself HTML and CSS as a kid by looking at the source code on websites and futzing with it until I figured out why it worked, but I don't really have experience with any other type of coding. But, I learn best from being able to see code that does what I'm trying to do, and dissecting it (and explanations from kind and learned people always help).
我是编程新手。小时候，我通过查看网站上的源代码并不断研究它来自学 HTML 和 CSS，直到我弄清楚它为什么起作用为止，但我真的没有任何其他类型的编码经验。但是，我从能够看到执行我正在尝试做的事情的代码并对其进行剖析（以及来自善良和博学的人的解释总是有帮助的）中学习得最好。
I'm in a situation where I'm pretty sure I could use an Excel macro to do something, I just don't know how to accomplish it. (I think a macro is the right choice because it's not a one-off, it's something I'd have to apply on a regular basis. My issue is very similar to this one: Macro for merging cells
我处于一种情况，我很确定我可以使用 Excel 宏来做某事，但我不知道如何完成它。（我认为宏是正确的选择，因为它不是一次性的，而是我必须定期应用的东西。我的问题与这个问题非常相似：用于合并单元格的宏
However, my goal is slightly more complicated. I want to do the same sort thing, only checking to see if there are multiple cells that are identical. So essentially, if multiple rows are identical in columns A, B, C, D, E, F, and O... then and only then, I want to merge the cells of those rows in column P.
但是，我的目标稍微复杂一些。我想做同样的事情，只检查是否有多个相同的单元格。所以基本上，如果 A、B、C、D、E、F 和 O 列中的多行相同......那么并且只有这样，我想合并 P 列中这些行的单元格。
I want to go from this:
我想从这个开始：
To this:
对此：
Like I said, I know very little about VBA. I tried what seemed logical to me, which was taking the code in the answer from the linked post, but duplicating the "lastRow = [B2].End(xlDown).Row" bit to apply to each column I need to check. For what I'm sure are obvious reasons to someone who knows what they are doing, that did not work.
就像我说的，我对 VBA 知之甚少。我尝试了对我来说似乎合乎逻辑的方法，它从链接的帖子中获取答案中的代码，但复制了“lastRow = [B2].End(xlDown).Row”位以应用于我需要检查的每一列。对于那些知道自己在做什么的人来说，我确信这是显而易见的原因，但这是行不通的。
Any tips for how to edit this code to accomplish what I want to do, or a kind soul willing to write it so I can do some reading and backwards-engineer it? Please let me know if anything I've said is unclear and I really appreciate anyone who can help.
关于如何编辑此代码以完成我想做的事情的任何提示，或者愿意编写它以便我可以进行一些阅读和反向工程的善良灵魂？如果我所说的任何内容不清楚，请告诉我，我非常感谢任何可以提供帮助的人。
回答by
Should be quite easy...
应该很容易...
Open you file and hit ALT+F11to open the VBE. Right click anywhere in the VBA Project Window and insert a module(*standard module, notclass, notuserform )
打开您的文件并点击ALT+F11打开 VBE。右键单击 VBA 项目窗口中的任意位置并插入一个module(*standard module, notclass, notuserform )
copy paste the below code
复制粘贴下面的代码
Sub Main()
Dim i As Long
Dim j As Long
Dim sameRows As Boolean
sameRows = True
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To 7
If StrComp(Cells(i, j), Cells(i + 1, j), vbTextCompare) Then
sameRows = False
End If
Next j
If sameRows Then
Range(Cells(i, 8), Cells(i + 1, 8)).Merge
End If
sameRows = True
Next i
End Sub
hit F5to run the macro and that should merge the cells for you
点击F5运行宏，这应该为你合并单元格
remember the conditions are the rows have to be next to each other in a vertical sequence.
请记住，条件是行必须以垂直顺序彼此相邻。
before running macro
在运行宏之前
and after
之后
回答by Philip
Better Answer, please give me credit, this will merge cells to create a "Box" or whatever else you're looking to do with merging cells.
更好的答案，请给我信用，这将合并单元格以创建一个“框”或任何您希望合并单元格做的事情。
Hotkey is Control+M
热键是 Control+M
Begin code:
开始代码：
Sub Mergethecells()
'
' Mergethecells Macro
' merge cells
'
' Keyboard Shortcut: Ctrl+m
'
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
End Sub
