Ändern Sie zuerst zwei Buchstaben in Excel-Spalten mit VBA

Ich habe 17 Blatt in Excel, wo ich die ersten zwei Buchstaben der aktiven Zellen in der Spalte WU jeden Tag ändern müssen. Ich habe versucht, dies mit dem folgenden Code zu tunÄndern Sie zuerst zwei Buchstaben in Excel-Spalten mit VBA

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

Aber der obige Code kürzt die Werte in den Zellen der WU-Säule. Wohin gehe ich im Code falsch? Oder gibt es eine andere einfachere Lösung mit einer Formel oder einem VBA-Code?

Quelle

2016-11-24 Tai Lung

Ein Beispiel für die Trunk? Sie geben kein Blatt in der String_2_Replace-Zeile an, das wichtig oder nicht wichtig ist. – SJR

DF8m00001 war der Wert in der WU1. Es änderte sich zu A8m00001 und als ich es erneut ausführte, änderte es sich zu m00001 und als nächstes änderte es sich zu 1. Obwohl ich den SDate mit Werten von heute morgen und übermorgen änderte –

Sieht so aus als wäre ReplaceString leer. – SJR

Die Variablen String_2_Replace und ReplaceString sind Strings. Ich denke ihre Werte müssen zwischen "" in den Selection.Replace Statements liegen.

Quelle

2016-11-24 14:07:08

Die Werte werden nicht abgeschnitten, auch werden sie nicht geändert –

OK. Und in Ihrem Beispiel "DF" möchten Sie, dass es in welche Buchstaben geändert wird? –

Sie ersetzen in der Spalte WU, aber Sie lesen String_2_Replace von WU2. Möglicherweise müssen Sie WU2 zu WU ändern. –

die Sie interessieren, hoffen, dass es Ihnen helfen kann:

I Lettre2NumCol im Internet gefunden. Ich verwende ColAddress in meinen Programmen die meiste Zeit.

Der Wert in A1 ist DF8m00001, in 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

Quelle

2016-11-24 15:45:57

Ändern Sie zuerst zwei Buchstaben in Excel-Spalten mit VBA

Antwort

Verwandte Themen