求汇总表拆分后能自动调节单元格列宽

wzd028

点击“按类别拆分”按钮，把汇总表拆分新的“采购明细拆分”表，拆分后各部门名称的单元格不能自动调节列宽，求各位大师如何设置拆分后才能自动调节列宽，谢谢！

     
   

dailj

手边没电脑，这个自己录制一个宏，复制代码就好了呀

美好每天

Sub J列和M到N列自动自动调节列宽()
' J列和M到N列自动自动调节列宽
  Range("J:J,M:N").EntireColumn.AutoFit
End Sub

‘在最后的代码中加上上面的代码，你试试看看行不行’

3190496160

Sub Sorting()   '拆分
  Dim arr, xD, s#, n%, i&, i2&
  Application.ScreenUpdating = False: Application.DisplayAlerts = False
  On Error Resume Next
  Tm = Timer
  Set TWK = ThisWorkbook
  arr = Sheets(1).[A1].CurrentRegion
  Set xD = CreateObject("scripting.dictionary")
  For i = 4 To UBound(arr)
    If xD.exists(arr(i, 2)) Then
      Set xD(arr(i, 2)) = Union(xD(arr(i, 2)), Rows(i))
    Else
      Set xD(arr(i, 2)) = Union(Rows(2), Rows(3), Rows(i))
    End If
  Next
  Workbooks.Add
  For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
  Next
  For i = 0 To xD.Count - 1
    With Sheets(i + 1)
      xD.items()(i).Copy Sheets(i + 1).[A1]
      .Name = xD.keys()(i)
      .Columns("A:V").Columns.AutoFit
      .[A1].CurrentRegion.Offset(2, 0).RowHeight = 28
    End With
    If Sheets.Count < xD.Count Then ActiveWorkbook.Sheets.Add AFTER:=Sheets(Sheets.Count)
  Next
  For i = 1 To Sheets.Count
    With Sheets(i)
      .Rows("1:1").Insert
      .[A1] = arr(1, 1)    '"月 度 采 购 计 划 汇 总 表"
      .[A1].Font.Size = 22
      .[A1].RowHeight = 50
      .Columns("S:S").ColumnWidth = 8
      .Range(.Cells(1, 1), .Cells(1, 22)).MergeCells = True
      .Range(.Cells(1, 1), .Cells(1, 22)).HorizontalAlignment = xlCenter
      arr = .[A1].CurrentRegion
      For i2 = 4 To UBound(arr)
        n = n + 1
        arr(i2, 1) = n
        s = s + arr(i2, 20)
      Next
      .Range("a1").Resize(UBound(arr), 1) = arr
      .Cells(n + 4, 19) = "合 计"
      .Cells(n + 4, 19).HorizontalAlignment = xlCenter
      .Cells(n + 4, 20) = s
      .Cells(n + 4, 20).NumberFormatLocal = "0.00"
      .Range(.Cells(n + 4, 1), .Cells(n + 4, 22)).Borders.LineStyle = xlContinuous
      .Columns("J:J").ColumnWidth = 14
      .Columns("m:n").ColumnWidth = 14
      n = 0: s = 0
    End With
  Next
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "采购明细拆分"
  Application.ScreenUpdating = True: Application.DisplayAlerts = True
  MsgBox "用时:    " & Round(Timer - Tm, 2) & "秒"
End Sub

3190496160

wzd028

谢谢各位老师，问题解决了。