相同的案例值但如果第一个字符是,则运行不同的公式

时间:2017-07-09 14:26:18

标签: excel vba excel-vba

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

我根据文件长度重命名文件名。我有2个文件长度= = 12但需要以不同的方式命名。我是否可以在该案例中包含if语句,以查看第一个字符是否为=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

获取任何帮助

1 个答案:

答案 0 :(得分:2)

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