仅从单元格中提取整数的一部分并将其复制到单独的列中

时间:2014-04-25 16:34:30

标签: vba excel-vba excel

我有一列数字的格式为1234567或1234567-1或1234567A1或123456-1。我需要遍历该列并创建一个具有核心编号的单独列(B列)。我的意思是1234567-1它在B列中有1234567.对于1234567它有1234567,1234567A1我需要整个数字1234567A1。几乎如果出现破折号我需要破折号之前的角色。如果出现一封信我需要整件事(除非是破折号)。否则我只需要前7个数字。

Sub UpdatePartNumber()


Dim lastRow As Long
Dim i As Long



lastRow = Cells(Rows.Count, 1).End(xlUp).Row


On Error Resume Next
Next c
For i = 2 To lastRow

Cells("A" & i).Select
LeftSeven = Left(Selection, 7)

    If Selection <> 0 Then
        Cells("B" & i).Value = LeftSeven
    End If
Next
End Sub

2 个答案:

答案 0 :(得分:0)

我会检查短划线,如果没有抓住整个内容,它是否有内容,请参阅下面的评论。

Sub UpdatePartNumber()

Dim lastRow As Long
Dim i As Long
Dim dashLocation As Integer

      'get the last row
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

On Error Resume Next

For i = 2 To lastRow
    'get the location of the dash, if there is one
    dashLocation = InStr(1, Cells(i, 1).Value, "-")
    'check for dash and if it is there grab all digits up to it
    If dashLocation > 0 Then
    Cells(i, 2).Value = Left(Cells(i, 1).Value, dashLocation - 1)
    Else
    'no dash so grab entire contents
    Cells(i, 2).Value = Cells(i, 1).Value
    End If
Next

End Sub

答案 1 :(得分:0)

您还可以遍历范围来执行此操作,从而允许您Offset您的位置并消除一些代码行。

使用On Error Resume Next时要小心。翻译它意味着“忽略任何运行时错误并继续下一行代码”。有时候这是你想要的行为,但是不正确地使用它可能会忽略bug并导致意外问题。

Sub UpdatePartNumber()

    '~~> dim variables and set initial values
        Dim rngNumberColumn As Range
            Set rngNumberColumn = activeworkbook.ActiveSheet.Range("A2", _
                                    activeworkbook.ActiveSheet.Range("A2").End(xlDown))
        Dim rngCell As Range
        Dim strNumber As String

    '~~> loop to extract core number
        For Each rngCell In rngNumberColumn
            strNumber = rngCell.value
            If InStr(strNumber, "-") > 0 Then
                strNumber = Left(strNumber, InStr(strNumber, "-") - 1)
            End If
            rngCell.Offset(0, 1).value = strNumber
        Next rngCell

End Sub