ich diesen Code aus Excel show leading zero in formula bar angepasst habe
Es verwendet Variante Arrays für Geschwindigkeit Effizienz, die Aktualisierung nur die UsedRange
Teil der Tabelle
- drücken Sie Alt & F11 zusammen, um den VBE
- Insert Modul
- Kopie zu gehen und den Code unten
- drücken Sie Alt & F11 zusammen Einfügen gehen Sie zurück zu Excel
- führen Sie das Makro aus der Registerkarte Entwickler
Es kann angepasst werden, um Leerzeichen Zellen zu ignorieren, wenn Sie dies wünschen - lassen Sie es mich wissen
Sub AddStrings()
Dim rng1 As Range
Dim rngArea As Range
Dim strRep1 As String
Dim strRep2 As String
Dim lngRow As Long
Dim lngCol As Long
Dim lngCalc As Long
Dim X()
strRep1 = """"
strRep2 = """"
ActiveSheet.UsedRange
Set rng1 = ActiveSheet.UsedRange
'Speed up the code by turning off screenupdating and setting calculation to manual
'Disable any code events that may occur when writing to cells
With Application
lngCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Test each area in the user selected range
'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
For Each rngArea In rng1.Areas
'The most common outcome is used for the True outcome to optimise code speed
If rngArea.Cells.Count > 1 Then
'If there is more than once cell then set the variant array to the dimensions of the range area
'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
X = rngArea.Value2
For lngRow = 1 To rngArea.Rows.Count
For lngCol = 1 To rngArea.Columns.Count
'replace the leading zeroes
X(lngRow, lngCol) = strRep1 & X(lngRow, lngCol) & strRep2
Next lngCol
Next lngRow
'Dump the updated array sans leading zeroes back over the initial range
rngArea.Value2 = X
Else
'caters for a single cell range area. No variant array required
rngArea.Value = strRep1 & rngArea.Value2 & strRep2
End If
Next rngArea
'cleanup the Application settings
With Application
.ScreenUpdating = True
.Calculation = lngCalc
.EnableEvents = True
End With
End Sub