在列命令按钮重置中合并单元格

Posted 2021-05-04

我是vba的新手，遇到了问题。当我第一次单击命令按钮时，我的代码工作到目前为止。它从一个工作表中获取数据并将其粘贴到“TEST”工作表中，从AZ中对其进行排序，然后合并A列中的相似单元格。但是，当我再次单击该按钮时，由于合并的单元格和数据，数据会发生变化格式搞砸了。我知道我需要某种类型的重置，所以当再次单击该按钮时，代码会像第一次单击它一样执行。我不确定如何实现这一点，任何反馈都会很棒。我强调了合并代码部分，因为我认为重置可能需要去的地方

Sub Button1_Click() ' Update Button

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim lastRowPart As Long
Dim lastRowCW As Long
Dim lastRowQty As Long
Dim lastRowDescrip As Long

'1. Copies and formats data
lastRowPart = Sheets("Inventory Overview").Range("F" & Rows.count).End(xlUp).Row
lastRowDescrip = Sheets("Inventory Overview").Range("G" & Rows.count).End(xlUp).Row
lastRowQty = Sheets("Inventory Overview").Range("I" & Rows.count).End(xlUp).Row
lastRowCW = Sheets("Inventory Overview").Range("L" & Rows.count).End(xlUp).Row

Sheets("TEST").Range("A2:A" & lastRowCW).Value = Sheets("Inventory Overview").Range("L2:L" & lastRowCW).Value
Sheets("TEST").Range("B2:B" & lastRowPart).Value = Sheets("Inventory Overview").Range("F2:F" & lastRowPart).Value
Sheets("TEST").Range("C2:C" & lastRowQty).Value = Sheets("Inventory Overview").Range("I2:I" & lastRowQty).Value
Sheets("TEST").Range("D2:D" & lastRowDescrip).Value = Sheets("Inventory Overview").Range("G2:G" & lastRowDescrip).Value
Sheets("TEST").Range("A1:A" & lastRowCW).Columns.AutoFit      
Sheets("TEST").Range("B1:B" & lastRowPart).Columns.AutoFit     
Sheets("TEST").Range("C1:C" & lastRowQty).Columns.AutoFit     
Sheets("TEST").Range("D1:D" & lastRowDescrip).Columns.AutoFit 

'2. Sort Cells
Dim sortSheet As Worksheet
Set sortSheet = ThisWorkbook.Worksheets("TEST")
Dim LastRow As Long

LastRow = sortSheet.Cells(Rows.count, 4).End(xlUp).Row

With sortSheet.Sort  ' sorts data from A to Z
 .SetRange sortSheet.Range("A2:D" & LastRow)
 .Header = xlGuess
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
End With

***'3. Merge CW Cells
   Dim rngMerge As Range, cell As Range, lastRowMerge As Long
   lastRowMerge = Range("A1").End(xlDown).Row
   Set rngMerge = Range("A1:A" & lastRowMerge)
  MergeAgain:
   For Each cell In rngMerge
    If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
        Range(cell, cell.Offset(1, 0)).Merge
        GoTo MergeAgain
    End If
Next***

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

答案

粘贴前你需要的只是：

Sheets("TEST").Cells.UnMerge

这将解密Sheet("TEST")中的所有单元格。如果您需要取消合并特定范围，那么只需使用以下内容：

Sheets("TEST").Range("A1:H586").Unmerge

另一答案

这是您的TEST表。它总是一块干净的床单吗？你的日常生活有什么意义？你总是可以这样：

'This deletes te worksheet "TEST" and creates a new one with the same name
Set sortSheet = ThisWorkbook.Worksheets("TEST")
sortSheet.Delete
set sortSheet = ThisWorkbook.Worksheets.Add
wsSheet.name = "TEST"

或者你可以解开一切：

sortSheet.Range("A2:D" & cStr(lastRowDescrip)).UnMerge

未合并的细胞应该照顾你的问题。不用说，但上面的所有行都应该在复制数据之前。