Question

我是vba的新手，遇到了问题。当我第一次单击命令按钮时，我的代码工作到目前为止。它从一张纸上获取数据并将其粘贴到＆＃34; TEST＆＃34; sheet，从A-Z对其进行排序，然后合并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

Answer 1

粘贴之前所需要的只是：

Sheets("TEST").Cells.UnMerge

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

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

Answer 2

你的这张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

未合并细胞应该解决您的问题。不用说，但上面的所有行都应该在复制数据之前出现。

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

2 个答案: