遍历单元格并根据情况分别处理

jacksc

test.rar (81.12 KB, 下载次数: 12)

2018-10-10 16:39 上传

点击文件名下载附件

各位老师：我用下面代码想达到两个目的，结果运行慢不说，最终还提示下标越界。请教更好的代码。谢谢！       
        1、若单元格前五个字符是“公式单元格”，则提取该单元格的后面字符；
        2、若单元格前五个字符不是“公式单元格”，则清空该单元格；
       
        Sub sldkfj()
            Application.ScreenUpdating = False
            r = Sheet1.Rows.Count
            c = Sheet1.Columns.Count
            For i = 1 To r
                For j = 1 To c
                    If Left(Cells(i, j), 5) = "公式单元格" Then
                        Cells(i, j) = Split(Cells(i, i), "")(1)
                    Else
                        Cells(i, j) = ""
                    End If
                Next
            Next
            Application.ScreenUpdating = True
        End Sub

dong20030432

1、应当取已用区域的行和列进行循环，而不是整个sheet
2、Cells(i, j) = Split(Cells(i, i), "")(1)这句应该有错误，无法提取你要的内容
3、cells(i,j)似乎应当改用cells(i,j).value

ericniming

因为有些单元格一共也没有5个字符，Left(Cells(i, j), 5)会出错

lsc900707

1. Sub sldkfj()
   
2.     Application.ScreenUpdating = False
   
3.     arr = ActiveSheet.UsedRange
   
4.     For i = 1 To UBound(arr)
   
5.         For j = 1 To UBound(arr, 2)
   
6.             If Left(arr(i, j), 5) = "公式单元格" Then
   
7.                 arr(i, j) = Replace(arr(i, j), "公式单元格", "")
   
8.             Else
   
9.                 arr(i, j) = ""
   
10.             End If
    
11.         Next
    
12.     Next
    
13.     ActiveSheet.UsedRange = arr
    
14.     Application.ScreenUpdating = True
    
15. End Sub

复制代码

lsc900707

代码需要审核，附件先供测试：

ericniming

我没用split函数，用了mid(****),你看看对不对吧。

jacksc

lsc900707 发表于 2018-10-10 17:00
代码需要审核，附件先供测试：

谢谢老师！
其实这个测试数据是 先将Excel 设置为“显示公式”状态，然后复制到 记事本，把所有 “=”号替换为 “公式单元格”而来，说明过程就复杂。
我本想达到的原始目标是：
1、若单元格为公式，则提取该公式”=“号后的字符；
2、若单元格不为公式，则清空该单元格；
请教代码如何修改？

lsc900707

jacksc 发表于 2018-10-10 17:30
谢谢老师！
其实这个测试数据是 先将Excel 设置为“显示公式”状态，然后复制到 记事本，把所有 “=”号 ...

试试这样可不可以：

1. Sub gj23w98()
   
2.     Application.ScreenUpdating = False
   
3.     arr = ActiveSheet.UsedRange
   
4.     For i = 1 To UBound(arr)
   
5.         For j = 1 To UBound(arr, 2)
   
6.             Cells(i, j) = Cells(i, j).Formula
   
7.             Cells.NumberFormatLocal = "@"
   
8.             If InStr(Cells(i, j), "=") Then
   
9.                 Cells(i, j) = Replace(Cells(i, j), "=", "")
   
10.             Else
    
11.                 Cells(i, j) = ""
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     Application.ScreenUpdating = True
    
16. End Sub

复制代码

lsc900707

jacksc 发表于 2018-10-10 17:30
谢谢老师！
其实这个测试数据是 先将Excel 设置为“显示公式”状态，然后复制到 记事本，把所有 “=”号 ...

试试这样行不行：
Sub gj23w98()
    Application.ScreenUpdating = False
    arr = ActiveSheet.UsedRange
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            Cells(i, j) = Cells(i, j).Formula
            Cells.NumberFormatLocal = "@"
            If InStr(Cells(i, j), "=") Then
                Cells(i, j) = Replace(Cells(i, j), "=", "")
            Else
                Cells(i, j) = ""
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub

lsc900707

jacksc 发表于 2018-10-10 17:30
谢谢老师！
其实这个测试数据是 先将Excel 设置为“显示公式”状态，然后复制到 记事本，把所有 “=”号 ...

代码贴了两次都要审核，先自行测试附件中的代码：