excel 用 vba 结合公式给单元格赋值

要vba找我..单击我的名字看联系方式.
编辑VBA需要你的原始文件,若你的文件涉及企业机密,可以修改内容.
记住,不要动格式.

最后的代码:
Sub cheng()
Dim i, j
For Each c In ThisWorkbook.Sheets
With c
j = .Range("J65535").End(xlUp).Row
For i = 6 To j
.Cells(i, 10) = Round(.Cells(i, 10) * 0.0015, 2)
.Cells(i, 11) = Round(.Cells(i, 11) * 0.0015, 2)
Next
End With
Next
End Sub

右击任意一个工作表名称，选择全选工作表，然后按照ouyangff的办法去做。

你运行一下这个宏，所有表的这两列从第四行开始到最后一行，全部乘0.0015
Sub 换成亩()
Dim R As Long
Dim x As Long
Dim y As Long
For x = 1 To Sheets.Count
With Sheets(x)
.Cells(3, 4) = Application.Substitute(.Cells(3, 4), "平方米", "亩")
.Cells(3, 5) = Application.Substitute(.Cells(3, 5), "平方米", "亩")
R = .Range("D65536").End(xlUp).Row
For y = 4 To R
.Cells(y, 4) = .Cells(y, 4) * 0.0015
.Cells(y, 5) = .Cells(y, 5) * 0.0015
Next y
End With
Next x
End Sub
修改一下楼上mamy老师的代码，更完善
Sub test()
Dim i, M, iRow, sh, arr
M = 0.0015
For Each sh In ThisWorkbook.Sheets
iRow = sh.[D65535].End(xlUp).Row
ReDim arr(1 To iRow, 1 To 2)
arr = sh.Range("D3:E" & iRow)
For i = 2 To UBound(arr)
arr(i, 1) = arr(i, 1) * M
arr(i, 2) = arr(i, 2) * M
Next
arr(1, 1) = Application.Substitute(arr(1, 1), "平方米", "亩")
arr(1, 2) = Application.Substitute(arr(1, 2), "平方米", "亩")
sh.Range("D3:E" & iRow) = arr
Next
End Sub

Sub test()
Dim i, M, iRow, sh, arr
M = 0.0015
For Each sh In ThisWorkbook.Sheets
iRow = sh.[D65535].End(xlUp).Row - 1
arr = sh.Range("D4:E" & iRow)
For i = 1 To UBound(arr)
arr(i, 1) = arr(i, 1) * M
arr(i, 2) = arr(i, 2) * M
Next
sh.Range("D4:E" & iRow) = arr
Next
End Sub