使用VBA更改Excel列中的前两个字母

时间:2016-11-24 13:08:43

标签: excel excel-vba vba

我在Excel中有17张纸,我必须每天更改列WU中活动单元格的前两个字母。我尝试使用以下代码

执行此操作
  Private Sub Workbook_Open()
'Becasue there are only 26*26 (676 Days) Possible prefixes at some point we have to start at AA again.
Dim TDate As Date
Dim SDate As Date
Dim DaysSpaned As Integer
Dim FirstLet As Integer
Dim SecondLet As Integer
Dim Let1 As String
Dim Let2 As String
Dim ReplaceString As String
Dim String_2_Replace As String

Application.ScreenUpdating = False

SDate = "10/5/2016" 'SET THE SATRTING DATE 10/3/2016
TDate = Format(Date, "Short Date") 'Convert the date format to MM / DD / YYYY

If TDate - SDate >= 7 Then  'We are counting WORKDAYS NOT TOTAL DAYS SO WE MUST REMOVE SAT AND SUN FROM THE CALC _ IF WE WANT TO COUNT WEEKENDS CHANGE THE
                            '"w" below to "d" and delete the lines of code with '*DEL after them and the If Statement on the line above this one
DaysSpaned = DateDiff("w", SDate, TDate) 'COUNTS WEEKS
DaysSpaned = DaysSpaned * 5 ' this line changes weeks to work days '*DEL
Else '*DEL
DaysSpaned = TDate - SDate '*Del
End If                      '*Del

'RESET THE COUNTER BACK TO AA FROM ZZ
Do Until DaysSpaned < 678
DaysSpaned = DaysSpaned - 676
Loop
'Day 1 = AA - Day 26 = BA so the first letter changes everyday

FirstLet = DaysSpaned / 2 - 1
SecondLet = DaysSpaned Mod 2

Select Case FirstLet
Case Is = 0
    Let1 = "A"
Case Is = 1
    Let1 = "B"
Case Is = 2
    Let1 = "C"
Case Is = 3
    Let1 = "D"
Case Is = 4
    Let1 = "E"
Case Is = 5
    Let1 = "F"
Case Is = 6
    Let1 = "G"
Case Is = 7
    Let1 = "H"
Case Is = 8
    Let1 = "I"
Case Is = 9
    Let1 = "J"
Case Is = 10
    Let1 = "K"
Case Is = 11
    Let1 = "L"
Case Is = 12
    Let1 = "M"
Case Is = 13
    Let1 = "N"
Case Is = 14
    Let1 = "O"
Case Is = 15
    Let1 = "P"
Case Is = 16
    Let1 = "D"
Case Is = 17
    Let1 = "R"
Case Is = 18
    Let1 = "S"
Case Is = 19
    Let1 = "T"
Case Is = 20
    Let1 = "U"

Case Is = 21
    Let1 = "V"
Case Is = 22
    Let1 = "W"
Case Is = 23
    Let1 = "X"
Case Is = 24
    Let1 = "Y"
Case Is = 25
    Let1 = "Z"

End Select

Select Case SecondLet
Case Is = 0
    Let2 = "A"
Case Is = 1
    Let2 = "B"
Case Is = 2
    Let2 = "C"
Case Is = 3
    Let2 = "D"
Case Is = 4
    Let2 = "E"
Case Is = 5
    Let2 = "F"
Case Is = 6
    Let2 = "G"
Case Is = 7
    Let2 = "H"
Case Is = 8
    Let2 = "I"
Case Is = 9
    Let2 = "J"
Case Is = 10
    Let2 = "K"
Case Is = 11
    Let2 = "L"
Case Is = 12
    Let2 = "M"
Case Is = 13
    Let2 = "N"
Case Is = 14
    Let2 = "O"
Case Is = 15
    Let2 = "P"
Case Is = 16
    Let2 = "Q"
Case Is = 17
    Let2 = "R"
Case Is = 18
    Let2 = "S"
Case Is = 19
    Let2 = "T"
Case Is = 20
    Let2 = "U"

Case Is = 21
    Let2 = "V"
Case Is = 22
    Let2 = "W"
Case Is = 23
    Let2 = "X"
Case Is = 24
    Let2 = "Y"
Case Is = 25
    Let2 = "Z"

End Select


ReplaceString = Let1 & Let2  ' COMBINE THE LETTERS
String_2_Replace = Left(Range("WU2").Value, 2)  'UPDATE THE STRING TO REPLACE AS IT WAS CHANGED FROM li

         'Actually replace the String
         Worksheets("ADMIN_ARB11").Activate
        Columns("WU:WU").Select

          Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_ARB13").Activate
         Columns("WU:WU").Select

        Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FVB1").Activate
        Columns("WU:WU").Select

          Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FVB1E").Activate
         Columns("WU:WU").Select

          Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FVB4").Activate
        Columns("WU:WU").Select

          Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
          SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
          ReplaceFormat:=False

          Worksheets("ADMIN_FVB4E").Activate
          Columns("WU:WU").Select

         Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

                  Worksheets("ADMIN_FV10").Activate
        Columns("WU:WU").Select

        Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FV1").Activate
        Columns("WU:WU").Select

          Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FV16").Activate
        Columns("WU:WU").Select

          Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString,  LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FV57").Activate
        Columns("WU:WU").Select

             Selection.Replace What:=String_2_Replace,     Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FV58").Activate
        Columns("WU:WU").Select

        Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FV60").Activate
Columns("WU:WU").Select

        Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString,  LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_AR14").Activate
        Columns("WU:WU").Select

         Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_SR12").Activate
        Columns("WU:WU").Select

        Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString,  LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FVE0").Activate
        Columns("WU:WU").Select

        Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString,   LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FV1E").Activate
        Columns("WU:WU").Select

         Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString,   LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        Worksheets("ADMIN_FVE6").Activate
        Columns("WU:WU").Select

          Selection.Replace What:=String_2_Replace, Replacement:=ReplaceString,     LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

     Application.ScreenUpdating = False
     End Sub

但是上面的代码会截断WU列的单元格中的值。我在代码中哪里出错了?或者是否有其他更简单的公式或VBA代码解决方案?

2 个答案:

答案 0 :(得分:0)

变量String_2_Replace和ReplaceString是字符串。我认为他们的值必须在Selection.Replace语句中的“”之间。

答案 1 :(得分:0)

试试这个,希望它可以帮到你:

我在互联网上找到了Lettre2NumCol。我大多数时候都在我的程序中使用ColAddress。

A1中的值是DF1m00001,在Sheet1中。

Sub test()
    Dim var1 As String, var2 As Integer, var3 As String

    var1 = Left(Range("A1"), 2)
     var2 = Lettre2NumCol(var1) + 1
     var3 = ColAddress(var2)

     Worksheets("Sheet1").Activate
        Columns("A:A").Select

          Selection.Replace What:=var1, Replacement:=var3, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

End Sub


Function ColAddress(col As Integer) As String
    Dim vArray
    If col <> 0 Then
        vArray = Split(Cells(1, col).Address(True, False), "$")
        Else
            MsgBox "Problem"
            End
    End If
    ColAddress = vArray(0)
End Function

Public Function Lettre2NumCol(ByVal Chaine As String) As Long
    Dim i As Long, ValeurCh As Long, v As Long
    Const ChaineAlpha As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    For i = 1 To Len(Chaine)
    ValeurCh = InStr(1, ChaineAlpha, Mid(UCase(Chaine), i, 1))
    v = v * 26 + ValeurCh
    Next
    Lettre2NumCol = v
End Function