2017-07-09 84 views
0

则运行不同的公式我正在重命名脚本,除非我有特定的文件名,否则所有脚本都正常工作。这在每个项目中都很常见。相同的大小写值,但如果第一个字符是

我正在根据文件长度重命名文件名。我有两个文件长度都是=到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 

THX任何帮助

+0

是的,你其实可以。一切都对我很好 - 你有问题吗? –

+0

@DougCoats在'Case 12'之后,我得到了一个'类型不匹配,运行时错误13'行 –

+1

你不能在同一行上有2个等号,这是错误的原因 – Lowpar

回答

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 
相关问题