我做错了什么？ VBA如果这个和这个然后这个

Question

I really need help ..

Im trying to get this code right. I need to put a 0 infront of a postcode. Only in not empty cells and cells shorter than 5.

For i = 2 To ende2
    If (Not IsEmpty(LTrim(Cells(i, 9).Value))) And Len(LTrim(Cells(i, 9).Value)) < 5 Then
         Cells(i, 9).Value = "0" & Cells(i, 9).Value
    End If
next i

the code returns a 0 infront of the postcode .. but puts a 0 into empty cells too .. why ?

Im new to programming .. so please dont be hard to me :P

Thanks for helping :)

LG Madosa

Answer 1

The LTrim causes the value to be non-empty, even though it is still a zero-length string. Try this:

If (Not IsEmpty(Cells(i, 9))) And Len(LTrim(Cells(i, 9).Value)) < 5 Then

Incidentally, if the values you are trying to add a zero to are numeric, the program will have no result. You will need to change the cell format to Text. Put this after the If line:

Cells(i, 9).NumberFormat = "@"

Answer 2

You don't need code.

Assuming postcodes are in Column A, add this formula into column B.

=IF(A1<>"","0"&A1,"")

The breakdown below explains.

' Checks the cell in A1 for something
    =IF(A1<>"",
' If there is, concatenate a "0" and whatever is in A1
        "0"&A1, 
' Otherwise put an empty string.
        "")

You can then copy Column B and choose Edit > Paste Special > Values to convert from the formula into text.

ALT+E, then S, then V, then Click OK.

Answer 3

While this code is longer is will be significantly faster as it

• ignores the empty cells to start with (using Set rng1 = Selection.SpecialCells(xlConstants, xlNumbers) )
• it uses variant arrays

code

Sub AddLeadingZeros()
    Dim rng1 As Range
    Dim rngArea As Range
    Dim strRep As String
    Dim lngRow As Long
    Dim lngCol As Long
    Dim lngCalc As Long
    Dim X()

    strRep = "'0"

    On Error Resume Next
    'Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8)
    Set rng1 = Selection.SpecialCells(xlConstants, xlNumbers)
    If rng1 Is Nothing Then Exit Sub
    On Error GoTo 0

   '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
                    'add leading zeroes
                    If Len(X(lngRow, lngCol)) < 5 Then X(lngRow, lngCol) = strRep & X(lngRow, lngCol)
                Next lngCol
            Next lngRow
            'Dump the updated array swith a leading zeroes back over the initial range
            rngArea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
            If (Len(rngArea.Value) < 5) Then rngArea.Value = strRep & rngArea.Value2
        End If
    Next rngArea

    'cleanup the Application settings
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
    End With

  End Sub