怎么能减少大量调格式这种重复动作

xhwong

系统导出来的表格，要调成自己指定的格式，有没有大神知道，怎么能一键操作？以减少大量调格式这种重复动作。

原始格式




我需要的结果

实际数据不止这么多。

我在网上找到一个VBA代码能删除空白行与列，其他的就不会了，我试着用代码删除掉空白行与列后录制宏，但不行。


Sub 检查所有工作表删除空白行列()
For icount = 1 To Sheets.Count '遍历工作簿下的所有工作表
maxrow = Sheets(icount).UsedRange.Rows.Count '检查行数
maxcol = Sheets(icount).UsedRange.Columns.Count '检查列数
For k = maxrow To 1 Step -1
    If WorksheetFunction.CountA(Sheets(icount).Rows(k)) = 0 Then Sheets(icount).Rows(k).Delete '删除行 End lf
Next
For k = maxcol To 1 Step -1
    If WorksheetFunction.CountA(Sheets(icount).Columns(k)) = 0 Then Sheets(icount).Columns(k).Delete '删除列 End lf
Next
Next
End Sub

mjm04

录制宏，Excel 与 WPS 都可以的；

对于这类重复操作很有用的，只需按 正确的操作步骤 操作一遍，后面就直接自动化了；

最大的好处是你可以一句代码都不写/不懂

hxj119

这类重复操作，录制宏是比较好的方法

xhwong

hxj119 发表于 2024-11-15 13:03
这类重复操作，录制宏是比较好的方法

我试了录制的宏操作不成功。

xhwong

mjm04 发表于 2024-11-15 13:01
录制宏，Excel 与 WPS 都可以的；

对于这类重复操作很有用的，只需按 正确的操作步骤 操作一遍，后面 ...

我试了录制宏后运行会报错

松永

你的原始数据里面应该也放上数据，不能为0，与最终格式不一样，不方便验证

xhwong

松永 发表于 2024-11-15 13:30
你的原始数据里面应该也放上数据，不能为0，与最终格式不一样，不方便验证

好的，我已经重新上传了附件。

xhwong

Sub TB格式调整() For icount = 1 To Sheets.Count '遍历工作簿下的所有工作表 maxrow = Sheets(icount).UsedRange.Rows.Count '检查行数 maxcol = Sheets(icount).UsedRange.Columns.Count '检查列数 For k = maxrow To 1 Step -1     If WorksheetFunction.CountA(Sheets(icount).Rows(k)) = 0 Then Sheets(icount).Rows(k).Delete '删除行 End lf Next For k = maxcol To 1 Step -1     If WorksheetFunction.CountA(Sheets(icount).Columns(k)) = 0 Then Sheets(icount).Columns(k).Delete '删除列 End lf Next Next   ' 插入空白列在第六列后面     Columns("G:G").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove     ' 插入空白列在第九列后面     Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove          Range("G:G").Interior.ColorIndex = 27 Range("J:J").Interior.ColorIndex = 27 Range("M:M").Interior.ColorIndex = 41  End Sub

xhwong

我拼凑出来3个步骤，1是删除所有空白行与列；2是在指定位置插入空白列；3是指定列标上指示颜色。

Sub TB格式调整()
For icount = 1 To Sheets.Count '遍历工作簿下的所有工作表
maxrow = Sheets(icount).UsedRange.Rows.Count '检查行数
maxcol = Sheets(icount).UsedRange.Columns.Count '检查列数
For k = maxrow To 1 Step -1
    If WorksheetFunction.CountA(Sheets(icount).Rows(k)) = 0 Then Sheets(icount).Rows(k).Delete '删除行 End lf
Next
For k = maxcol To 1 Step -1
    If WorksheetFunction.CountA(Sheets(icount).Columns(k)) = 0 Then Sheets(icount).Columns(k).Delete '删除列 End lf
Next
Next
  ' 插入空白列在第六列后面
    Columns("G:G").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ' 插入空白列在第九列后面
    Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
   
    Range("G:G").Interior.ColorIndex = 27
Range("J:J").Interior.ColorIndex = 27
Range("M:M").Interior.ColorIndex = 41

End Sub