Excel如何用VBA实现单元格内遇到1、2、3、4、这样的就自动换行？

125675117

楼主能不能传个附件上来啊，谢谢

vistababy

125675117 发表于 2024-2-5 09:05
楼主能不能传个附件上来啊，谢谢

已经上传。在这。
2024.2.5 18：55分更新重传了附件。优化了速度，跳过了空单元格，并对全选表格或超10倍范围选择单元格可能导致的不必要的卡顿进行了优化。数据多的话，上百行总体感觉速度还是慢，去掉自动行高那2行能快1倍。

自动换行测试文件.rar (21.6 KB, 下载次数: 57)

2024-2-5 19:42 上传

点击文件名下载附件

125675117

vistababy 发表于 2024-2-5 11:09
已经上传。在这

已经测试，可以使用，希望增加一个功能，自动监测有内容的单元格，并对单元格进行处理，避免在选择某行执行程序时对空白单元格处理，导致时间加长，不得不强行退出。

vistababy

125675117 发表于 2024-2-5 14:34
已经测试，可以使用，希望增加一个功能，自动监测有内容的单元格，并对单元格进行处理，避免在选择某行执 ...

这个问题我也遇到过，不过我没有做处理，因为我都是选中具体的单元格进行处理，但是对于一些人喜欢双击左上角全选所有单元格（相当于选中了1048576行），将会造成卡死。我弄一下，将会屏蔽这种情况，当发现选中了所有单元格，将自动选中所有有用单元格。

vistababy

125675117 发表于 2024-2-5 14:34
已经测试，可以使用，希望增加一个功能，自动监测有内容的单元格，并对单元格进行处理，避免在选择某行执 ...

32楼重新上传了附件。

vistababy

。。。。。。。。。。。。。。。。

vistababy

125675117 发表于 2024-2-5 14:34
已经测试，可以使用，希望增加一个功能，自动监测有内容的单元格，并对单元格进行处理，避免在选择某行执 ...

32楼重传了附件。感谢建议。这个功能我平时其实用得少，只拿了那个上传测试文件不停地试验，这2天都在弄这个。。哈哈
速度方面没在意。后来我拿一个200行×10列的文件处理，竟然要25秒？优化以后只要5秒，可能是有数据的单元格少的原因，如果全有数据，还是一样慢。但如果去掉自动行高那2行，还能快1倍。

125675117

vistababy 发表于 2024-2-5 18:57
32楼重传了附件。感谢建议。这个功能我平时其实用得少，只拿了那个上传测试文件不停地试验，这2天都在弄 ...

我是不小心选择了一行，结果就假死了，猜测应该是对空白单元格也在处理。

panglong00

做造价的人表示十分有用!感谢。

建议把相同的代码写成小的过程or函数，精简一下。提高可读性。

vistababy

125675117 发表于 2024-2-6 08:34
我是不小心选择了一行，结果就假死了，猜测应该是对空白单元格也在处理。

选中一行或一列或是点左上角全选，确实是习惯性操作。不过我已经全部禁止了，感觉不太好。
对于一个文件来说，一般列数不会太多，100列应该很少有吧。
我刚又测试了一下，下面2段完全可以删除，对速度影响不大，关键是防范点上面的ABCD导致选择了1048576行引起的卡死问题。
点左边的12345行，选择的是行数，但处理的其实是列数。
所以处理的时候不要点ABCDEFG（1048576相关内容就是禁止此操作），而是点1234567，就没事。


下面2段内容及前面相关内容可以删除，保留1048576内容：

'    If totalselectCols = 16384 Or totalselectCols = 256 Then
'        MsgBox "您已经选择了" & totalselectCols & "列，可能是Excel支持的最大列数，禁止全选所有单元格列数进行操作，已为您选择了所有数据单元格,请重试!"
'        Range("A1").Select
'        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
'        Exit Sub
'    End If
   
'    If totalselectRows > 最大行号 * 10 Or totalselectCols > 最大列号 * 10 Then
'        MsgBox "您选择的行数或列数远远超过有效数据行列数，已为您选择了所有数据单元格,请重试!"
'        Range("A1").Select
'        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
'        Exit Sub
'    End If