代码之家  ›  专栏  ›  技术社区  ›  Matt Taylor

大小写值相同,但如果第一个字符为

  •  0
  • Matt Taylor  · 技术社区  · 7 年前

    我正在做一个重命名脚本,所有的工作,除非我有一个特定的文件名。这在每个项目中都很常见。

    =0,c,e" ?

    Sub Convert()
    Application.ScreenUpdating = False
    
    Dim rng As Range, aCell As Range
    Dim val As String
    Dim LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("A2:A" & LastRow)
    
    For Each aCell In rng.Cells
    Select Case Len(aCell)
        Case 12
            If val = Left(aCell, 1) = "0" Or "c" Or "e" Then 'Example: 01730101.pdf = S-173-0101.pdf
            val = "S-" & Mid(aCell, 2, Len(aCell) - 9) & "-" & Mid(aCell, 5, Len(aCell) - 8)
            Else 'Example: 173d0071.pdf = S-173-D7.pdf
            val = "S-" & Left(aCell, Len(aCell) - 9) & "-" & Mid(aCell, 4, Len(aCell) - 8)
            End If
        Case 13 'Example: 173d00710.pdf = S-173-D7.pdf
            val = "S-" & Left(aCell, Len(aCell) - 10) & "-" & Mid(aCell, 4, Len(aCell) - 9)
        Case 15 'Example: 173d170c071.pdf = SD-170-C7.pdf
            val = "SD-" & Left(aCell, Len(aCell) - 15) & Mid(aCell, 5, Len(aCell) - 12) & "-" & Mid(aCell, 8, Len(aCell) - 12)
        Case 16 'Example: REF-173d0071.pdf = REF-173-D7.pdf
            val = Left(aCell, Len(aCell) - 9) & "-" & (Mid(aCell, 8, Len(aCell) - 12))
        Case 17 'Example: REF173d00710.pdf = REF-173-D7.pdf
            val = Left(aCell, Len(aCell) - 10) & "-" & (Mid(aCell, 8, Len(aCell) - 13))
    On Error GoTo whoa
        Case Else
            val = "_Mod " & Left(aCell, Len(aCell) - 4)
    End Select
    
    val = UCase(val)
    
    val = val & " " & aCell.Offset(, 2) & aCell.Offset(, 3)
    
    aCell.Offset(, 1).Value = val
    Next
    Call RemoveZero
    Call RemoveBadChar
        Range("C1").Select
        Worksheets("Rename").Columns("B").AutoFit
        Application.ScreenUpdating = True
    whoa:
    MsgBox "Please delete any empty rows."
    ActiveSheet.Range("A1").End(xlDown).Offset(1).EntireRow.Select
    Application.ScreenUpdating = True
    Exit Sub
    End Sub
    

    Thx有任何帮助

    1 回复  |  直到 7 年前
        1
  •  2
  •   Lowpar    7 年前
    Sub Convert()
    Application.ScreenUpdating = False
    
    Dim rng As Range, aCell As Range
    Dim val As String, check
    Dim LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("A2:A" & LastRow)
    
    For Each aCell In rng.Cells
    Select Case Len(aCell)
        Case 12
            'I added a check here
            check = Left(aCell, 1)
            If check = "0" Or check = "c" Or check = "e" Then  'Example: 01730101.pdf = S-173-0101.pdf
            val = "S-" & Mid(aCell, 2, Len(aCell) - 9) & "-" & Mid(aCell, 5, Len(aCell) - 8)
            Else 'Example: 173d0071.pdf = S-173-D7.pdf
            val = "S-" & Left(aCell, Len(aCell) - 9) & "-" & Mid(aCell, 4, Len(aCell) - 8)
            End If
            check = ""
        Case 13 'Example: 173d00710.pdf = S-173-D7.pdf
            val = "S-" & Left(aCell, Len(aCell) - 10) & "-" & Mid(aCell, 4, Len(aCell) - 9)
        Case 15 'Example: 173d170c071.pdf = SD-170-C7.pdf
            val = "SD-" & Left(aCell, Len(aCell) - 15) & Mid(aCell, 5, Len(aCell) - 12) & "-" & Mid(aCell, 8, Len(aCell) - 12)
        Case 16 'Example: REF-173d0071.pdf = REF-173-D7.pdf
            val = Left(aCell, Len(aCell) - 9) & "-" & (Mid(aCell, 8, Len(aCell) - 12))
        Case 17 'Example: REF173d00710.pdf = REF-173-D7.pdf
            val = Left(aCell, Len(aCell) - 10) & "-" & (Mid(aCell, 8, Len(aCell) - 13))
    On Error GoTo whoa
        Case Else
            val = "_Mod " & Left(aCell, Len(aCell) - 4)
    End Select
    
    val = UCase(val)
    
    val = val & " " & aCell.Offset(, 2) & aCell.Offset(, 3)
    
    aCell.Offset(, 1).Value = val
    Next
    Call RemoveZero
    Call RemoveBadChar
        Range("C1").Select
        Worksheets("Rename").Columns("B").AutoFit
        Application.ScreenUpdating = True
    whoa:
    MsgBox "Please delete any empty rows."
    ActiveSheet.Range("A1").End(xlDown).Offset(1).EntireRow.Select
    Application.ScreenUpdating = True
    Exit Sub