批量处理多列数据格式

jsfc

批量处理多列数据格式：
1、A列不足6位数，前加0
2、H列四舍五入保留2位小数【注：列中有“0”和“空格”】
3、J、K、P列去掉"T00"【注：列中有“空格”】
4、L、M列除10000，四舍五入保留2位小数【注：列中有“空格”】
5、N、O列除100000000，四舍五入保留2位小数【注：列中有“空格”】

deadzlq

PQ参考解法

jsfc

deadzlq 发表于 2019-9-8 14:55
PQ参考解法

谢谢！想要用vba处理

大灰狼1976

附件请参考。

1. Sub test()
   
2. Dim r&
   
3. r = Cells(Rows.Count, 1).End(3).Row
   
4. Application.ScreenUpdating = False
   
5. Range("a3:p" & r).SpecialCells(xlCellTypeBlanks) = 0
   
6. Columns("a").NumberFormatLocal = "000000"
   
7. Union(Columns("h"), Columns("l:o")).NumberFormatLocal = "0.00"
   
8. Range("h3:h" & r) = Evaluate("""=text(""&h3:h" & r & "&"",""""0.00"""")*1""")
   
9. Range("h3:h" & r) = Range("h3:h" & r).Value
   
10. Union(Columns("j:k"), Columns("p")).NumberFormatLocal = "yyyy-mm-dd"
    
11. Union(Range("j3:k" & r), Range("p3:p" & r)).Replace "T00", ""
    
12. Range("l3:m" & r) = Evaluate("""=text(""&l3:m" & r & "&""/10^4,""""0.00"""")*1""")
    
13. Range("l3:m" & r) = Range("l3:m" & r).Value
    
14. Range("n3:o" & r) = Evaluate("""=text(""&n3:o" & r & "&""/10^8,""""0.00"""")*1""")
    
15. Range("n3:o" & r) = Range("n3:o" & r).Value
    
16. Application.ScreenUpdating = True
    
17. MsgBox "Done!"
    
18. End Sub

复制代码

大灰狼1976

代码稍作修改，功能不变。

1. Sub test()
   
2. Dim r&
   
3. r = Cells(Rows.Count, 1).End(3).Row
   
4. Application.ScreenUpdating = False
   
5. Range("a3:p" & r).SpecialCells(xlCellTypeBlanks) = 0
   
6. Columns("a").NumberFormatLocal = "000000"
   
7. Union(Columns("h"), Columns("l:o")).NumberFormatLocal = "0.00"
   
8. Range("h3:h" & r) = Evaluate("""=text(""&h3:h" & r & "&"",""""0.00"""")*1""")
   
9. Union(Columns("j:k"), Columns("p")).NumberFormatLocal = "yyyy-mm-dd"
   
10. Union(Range("j3:k" & r), Range("p3:p" & r)).Replace "T00", ""
    
11. Range("l3:m" & r) = Evaluate("""=text(""&l3:m" & r & "&""/10^4,""""0.00"""")*1""")
    
12. Range("n3:o" & r) = Evaluate("""=text(""&n3:o" & r & "&""/10^8,""""0.00"""")*1""")
    
13. UsedRange = UsedRange.Value
    
14. Application.ScreenUpdating = True
    
15. MsgBox "Done!"
    
16. End Sub

复制代码

jsfc

大灰狼1976 发表于 2019-9-8 15:15
代码稍作修改，功能不变。

谢谢！完美解决。

donghui2363

大灰狼1976 发表于 2019-9-8 15:12
附件请参考。

厉害，我这还叭叭的写循环判断呢，您这几行代码搞定

jsfc

大灰狼1976 发表于 2019-9-8 15:15
代码稍作修改，功能不变。

4楼，K列原来是空格的，最后显示结果是：1900-01-00
5楼，UsedRange = UsedRange.Value，显示424错误，要求对象，去掉这句运行正常，但还是K列原来是空格的，最后显示结果是：1900-01-00

大灰狼1976

变通一下。

1. Sub test()
   
2. Dim r&, rng As Range
   
3. r = Cells(Rows.Count, 1).End(3).Row
   
4. Application.ScreenUpdating = False
   
5. Set rng = Range("a3:p" & r).SpecialCells(xlCellTypeBlanks)
   
6. rng = 0
   
7. Columns("a").NumberFormatLocal = "000000"
   
8. Union(Columns("h"), Columns("l:o")).NumberFormatLocal = "0.00"
   
9. Range("h3:h" & r) = Evaluate("""=text(""&h3:h" & r & "&"",""""0.00"""")*1""")
   
10. Union(Columns("j:k"), Columns("p")).NumberFormatLocal = "yyyy-mm-dd"
    
11. Union(Range("j3:k" & r), Range("p3:p" & r)).Replace "T00", ""
    
12. Range("l3:m" & r) = Evaluate("""=text(""&l3:m" & r & "&""/10^4,""""0.00"""")*1""")
    
13. Range("n3:o" & r) = Evaluate("""=text(""&n3:o" & r & "&""/10^8,""""0.00"""")*1""")
    
14. UsedRange = UsedRange.Value
    
15. rng = ""
    
16. Application.ScreenUpdating = True
    
17. MsgBox "Done!"
    
18. End Sub

复制代码

jsfc

大灰狼1976 发表于 2019-9-8 19:01
变通一下。

谢谢，全部正常显示了