|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub 复制()
- Application.ScreenUpdating = False: Application.DisplayAlerts = False: With Sheets("表2")
- .[C3].Resize(.[C3].End(xlDown).Row - 2, 3).ClearContents
- .[AM3].Resize(.[AM3].End(xlDown).Row - 2, 1).UnMerge
- .[AL3].Resize(.[AL3].End(xlDown).Row - 2, 2).ClearContents
- Sheets("表1").[C3].Resize(Sheets("表1").[C3].End(xlDown).Row - 2, 3).Copy .[C3]
- Sheets("表1").[G3].Resize(Sheets("表1").[G3].End(xlDown).Row - 2, 3).Copy .[AL3]
- .[AM3].Resize(.[AM3].End(xlDown).Row - 2, 1).WrapText = True
- .[AL3].Resize(.[AL3].End(xlDown).Row - 2, 1).WrapText = False
- AD = "AM3": m = 3
- For i = 4 To .[C3].End(xlDown).Row + 1
- If .Range("C" & i).Text <> .Range("C" & i - 1).Text Or .Range("AM" & i).Text <> .Range("AM" & i - 1).Text Then _
- .Range(AD).Resize(i - m, 1).Merge: AD = Range("AM" & i).Address: m = i
- Next i: .Cells.EntireRow.AutoFit: End With
- Application.DisplayAlerts = True: Application.ScreenUpdating = True
- End Sub
复制代码 |
|