Question

EXCEL执行宏后数字自动变成日期格式了

录制了一个替换宏，设置替换掉所有指定文字，比如GM，于是01-2089GM 变成01-2089
录制的时候没有问题，01-2089GM正常变成01-2089
但是自动运行该宏后，01-2089GM就变成Jan-89，输入框显示的是2089/1/1，改回文本格式就是69034
搜索了一下网上常见解决方案都没有效果（都是针对输入后变日期，找不到跟宏有关的）：
1.提前设置该单元格为文本格式——没有效果，执行宏后还是日期，格式直接变成自定义
2.自定义格式中，删除相关格式——我这所有涉及日期的自定义格式都不可删除，删除按钮是灰色的
求大神指教

Answer 1

将替换的 01-2089 改成 '01-2089 ,加上 ‘ 号表示强制为文本模式

追问

可以用公式或者宏批量加，再批量去掉，保持01-2089这样的最终效果吗？

追答

可以的！！只要前面加上 ’ 号都表示为强制文本模式。

Answer 2

宏代码做一下更改，替换掉指定文字后，在数值前加上英文单引号'，然后再给单元格赋值，即可解决

Answer 3

你想要干什么？
麻烦用追问的形式描述下，重新帮你写一个

追问

只是想要去掉一串编号中常见的后缀或前缀，比如GM、FR，编号没什么规律，有数字有字母，GM这样的是前期人为加上的，后期要去掉。去掉后正好有的数字长得像日期，自动变日期了……

追答

额，好吧，其实楼下已经回答了，在处理字符串的时候，在前面加一个半角单引号，就会自动转换成文本型了。
比如str="'" & str : cells(i,j)=str
这样就不会转变成日期格式了。

追问

要的很简单：将表中所有字符串中的GM去掉，保证去掉后的字符串不变成日期或者什么奇怪的东西= =对了，GM必须区分大小写。根据你的意思步骤应该还包括：先全部加上“'”，去掉GM后，再全部去掉“'”。

追答

sub t()
    dim dic as object,rng as range
    set dic = createobject("scripting.dictionary")
    dic("GM")=""
    dic("FR")="" '如果还要删除其他的就按这个格式复制就好了。
    for each ke in dic.keys
        do
            set rng=cells.find(ke,LookAt:=xlPart)
            if rng is nothing then exit do
            rng="'" & replace(rng,ke,"")
        loop
    next 
end sub

这样应该就可以了，你先试试，我没测试过。

追问

高人！最后一个问题，dic("GM")=""为啥不能替换，只能用来删除，引号里填什么都是删除，想替换怎么写

追答

额，这个疏忽了
把代码改一下
Replace(rng,ke,dic(ke))

Dic("GM")="xx"

想删除，引号间什么都不要写

追问

大概有十几个关键词要改的，几百条数据试运行都挺好，跑两万条，卡死……

追答

卡死是不会的，只是运行得久而已。

对单元格的格式有要求吗？没有的话

sub t()
    dim dic as object,rng as range
    set dic = createobject("scripting.dictionary")
    dic("GM")=""
    dic("FR")="" '如果还要删除其他的就按这个格式复制就好了。
    arr=activesheet.usedrange
    for i=1 to ubound(arr,1)
        for j=1 to ubound(arr,2)
            if arr(i,j)<>"" then
                for each ke in dic.keys
                    if arr(i,j) like "*" & ke & "*" then
                        arr(i,j)=replace(arr(i,j),ke,dic(ke))
                    end if
                next
            end if
        next
    next
    activesheet.usedrange.cells(1,1).resize(ubound(arr,1),ubound(arr,2))=arr 
end sub

追问

高人啊，这个不行，还是会变日期

追答

sub t()
    dim dic as object,rng as range
    set dic = createobject("scripting.dictionary")
    dic("GM")=""
    dic("FR")="" '如果还要删除其他的就按这个格式复制就好了。
    arr=activesheet.usedrange
    for i=1 to ubound(arr,1)
        for j=1 to ubound(arr,2)
            if arr(i,j)<>"" then
                for each ke in dic.keys
                    if arr(i,j) like "*" & ke & "*" then
                        arr(i,j)="'" & replace(arr(i,j),ke,dic(ke))'这里忘记加单引号了
                    end if
                next
            end if
        next
    next
    activesheet.usedrange.cells(1,1).resize(ubound(arr,1),ubound(arr,2))=arr 
end sub

 忘记加单引号了……

追问

不能运行， If arr(i, j) "" Then 这句需要调试， error2042