VBA - 使用.Find方法

时间:2015-07-01 14:39:03

标签: excel vba excel-vba find

我正在使用.Find方法查找包含值“TL”和“CT”的一部分的行中的单元格。代码目前所做的是查看C列中的每一行,修剪“TL-”的任何变化(即“TL-”,“TL - ”,“TL - ”),然后将其后的数字限制为仅有6数字。示例:如果它有5个数字,它将在“TL-”之后添加0,如果它有4个数字,它将在“TL-”之后添加2 0。

我在单元格中有其他值,所以它现在做什么更改所有值以执行上述方法(如下所示)

Start:         Output:
TL-000872  ->  TL-000872
TL-0786    ->  TL-000786
CT-74      ->  TL-000074
GS8; 278K  ->  TL-008278

我需要它做什么是正在运行的代码,但仅适用于包含某些“TL”值的单元格,执行相同的代码,但在包含某些“CT”的单元格上只有4个数字“价值,并跳过(保持原样)其他任何东西。

Start:         Output:
TL-000872  ->  TL-000872
TL-0786    ->  TL-000786
CT-74      ->  CT-0074
GS8; 278K  ->  GS8; 278K

My .Find方法肯定不起作用。我认为这是主要问题;没有正确地找到具有“TL”和“CT”的细胞。有什么建议吗?

注意:StartSht是带有代码的工作簿,其中存在所有要更改的值。

Dim str As String, ret As String, tmp As String, j As Integer, k As Integer

If Not StartSht.Range("C2").End(xlDown).Find(What:="TL", LookAt:=xlPart, LookIn:=xlValues) Is Nothing Then
For k = 2 To StartSht.Range("C2").End(xlDown).Row
    ret = ""
    str = StartSht.Range("C" & k).Value
        For j = 1 To Len(str)
            tmp = Mid(str, j, 1)
            If IsNumeric(tmp) Then ret = ret + tmp
        Next j

        For j = Len(ret) + 1 To 6
            ret = "0" & ret
        Next
        ret = "TL-" & ret
        StartSht.Range("C" & k).Value = ret

        Next k

ElseIf Not StartSht.Range("C2").End(xlDown).Find(What:="CT", LookAt:=xlPart, LookIn:=xlValues) Is Nothing Then
For k = 2 To StartSht.Range("C2").End(xlDown).Row
    ret = ""
    str = StartSht.Range("C" & k).Value
        For j = 1 To Len(str)
            tmp = Mid(str, j, 1)
            If IsNumeric(tmp) Then ret = ret + tmp
        Next j

        For j = Len(ret) + 1 To 4
            ret = "0" & ret
        Next
        ret = "CT-" & ret
        StartSht.Range("C" & k).Value = ret

Next k

Else

End If

修改

当前代码在“TL-”之后使用少于6个数字的TL,并在“TL-”之后立即添加0,直到长度为6。 (即TL-0098 - > TL-000098,添加两个0)。如果TL有超过6个数字并且在“TL-”之后立即删除零直到长度为6,我还需要它 更简单的代码可能是简单地删除“ - ”之后的任何数字,直到长度为6。

实施例

TL-0009999   ->  delete one 0  -> TL-009999
TL-0948398   ->  delete one 0  -> TL-948398
TL-00000008  ->  delete two 0s -> TL-000008

1 个答案:

答案 0 :(得分:1)

将以上代码替换为以下代码。

更新代码:

Dim str As String, ret As String, tmp As String, j As Integer, k As Integer

For k = 2 To Sheets("Test").Range("C2").End(xlDown).Row
        ret = ""
        str = Sheets("Test").Range("C" & k).Value

        If InStr(str, "TL") > 0 Then
            For j = 1 To Len(str)
                tmp = Mid(str, j, 1)
                If IsNumeric(tmp) Then
                    ret = ret + tmp
                ElseIf j > 5 And tmp = "T" Then
                    Exit For
                End If

            Next j

            For j = Len(ret) + 1 To 6
                ret = "0" & ret
            Next j

            If Len(ret) > 6 Then
                Debug.Print Len(ret)
                For j = Len(ret) To 7 Step -1
                If Mid(ret, 1, 1) = "0" Then
                    ret = Right(ret, j - 1)
                End If
                Next j
            End If

            ret = "TL-" & ret
            Sheets("Test").Range("C" & k).Value = ret
        ElseIf InStr(str, "CT") Then
            For j = 1 To Len(str)
                tmp = Mid(str, j, 1)
                If IsNumeric(tmp) Then ret = ret + tmp
            Next j

            For j = Len(ret) + 1 To 4
                ret = "0" & ret
            Next
            ret = "CT-" & ret
            Sheets("Test").Range("C" & k).Value = ret
        End If

      Next k