Question

我正在编写一个非常简单的vba代码，用于迭代第2行中每个单元格中的字母/数字，并且只保留数字。每个单元格以4到7个数字开头，然后是字母（1个或更多），.和数字，或下划线，字母和数字。

我遇到的问题是我的代码只返回某些单元格的正确值。仅正确清除具有.的单元格。带有下划线的那些删除_之后的所有内容，但保留_本身，带字母的单元格保留字母，但删除.及其后的任何内容。

这是我的代码：

Sub getIDs()
Dim counter As Integer
counter = 1
Dim rowCounter As Integer
rowCounter = 2
Dim original As String
original = ""
Dim newText As String
newText = ""

Do While Len(Cells(rowCounter, 2)) > 0
    Do While counter <= Len(Cells(rowCounter, 2))
        If Not IsNumeric((Mid(Cells(rowCounter, 2).Value, counter, 1))) Or Mid(Cells(rowCounter, 2).Value, counter, 1) = "_" Then
            Exit Do
        Else
            counter = counter + 1
        End If
    Loop
    newText = Left(Cells(rowCounter, 2), counter)
    Cells(rowCounter, 2) = newText
    rowCounter = rowCounter + 1
Loop

End Sub

示例：原始单元格包含这四种类型的信息（数字不同）：

Input            Desired output    Actual output  Actual output OK?
----------------|-----------------|--------------|-------------------------
12345_v2.jpg     12345             12345_         No, "_" should be removed
293847.psd       293847            293847         OK
82364382.1.tga   82364382          82364382       OK  
172982C.5.tga    172982            172982C        No, "C" should be removed

Answer 1

所以我发现你的代码存在两个问题。第一个计数器，当您设置新文本时，确实需要为counter-1，因为这是非数字或下划线字符的位置。在柜台点复制将为您提供额外的角色。

第二个问题是你需要在内部Do循环之外重置计数器变量，否则你将从上一个最后找到的字符的位置开始。试试这个。

Sub getIDs()
Dim counter As Integer
counter = 1
Dim rowCounter As Integer
rowCounter = 2
Dim original As String
original = ""
Dim newText As String
newText = ""

Do While Len(Cells(rowCounter, 2)) > 0
    counter = 1
    Do While counter <= Len(Cells(rowCounter, 2))
        If Not IsNumeric((Mid(Cells(rowCounter, 2).Value, counter, 1))) Or Mid(Cells(rowCounter, 2).Value, counter, 1) = "_" Then
            Exit Do
        Else
            counter = counter + 1
        End If
    Loop
    newText = Left(Cells(rowCounter, 2), counter - 1)
    Cells(rowCounter, 2) = newText
    rowCounter = rowCounter + 1
Loop

End Sub

Answer 2

这将删除点和下划线。

我必须跑;没时间删除信件。但这应该让你走上正轨。我明天可能会继续。

Sub lkjhlkjh()
    Dim s As String
    Dim iUnderscore As Long
    Dim iDot As Long
    Dim iCut As Long
    s = Sheet1.Cells(1, 1)
    iUnderscore = InStr(s, "_")
    iDot = InStr(s, ".")
    If iUnderscore = 0 Then
        If iDot = 0 Then
            'Don't cut
        Else
            iCut = iDot
        End If
    Else
        If iDot = 0 Then
            iCut = iUnderscore
        Else
            If iDot > iUnderscore Then
                iCut = iUnderscore
            Else
                iCut = iDot
            End If
        End If
    End If
    If iCut > 0 Then s = Left(s, iCut - 1)
    Sheet1.Cells(1, 1) = s
End Sub

为什么我的代码忽略了下划线？

2 个答案: