将一列中的邮政编码拆分为 2 列

Question

这就是我的最终结果应该是什么样子。如果没有四位数字移到第二列，则用 4 个零填充。

如果第一列只有 5 位数字，如何将一列中的邮政编码拆分为 2 列并填充第 2 列中的空单元格？

这是我一直在使用的东西

Dim ws As Worksheet
Dim cell As Range

Set ws = Worksheets("sheet1")

For Each cell In ws.Range("K2:K500").Cells
    cell.Offset(0, 1).Value = Left(cell.Value, 5)
Next cell
   
Dim cel As Range, rngC As Range, rngB As Range
Dim lastRowA As Long, lastRowB As Long

With ws
    lastRowK = .Cells(.Rows.Count, "K").End(xlUp).Row 'last row of column A
    lastRowL = .Cells(.Rows.Count, "L").End(xlUp).Row 'last row of column B
    For Each cel In .Range("K2:K" & lastRowL)   'loop through column L
        'check if cell in column A exists in column B
        If WorksheetFunction.CountIf(.Range("K2:K" & lastRowL), cel) = 0 Then
            cel.Offset(0, 3).Value = Right(cel.Value, 4)
            '.Range("M" & cel.Row) = Right(cell.Value, 4)
        Else
            .Range("M" & cel.Row) = "0000"
        End If
    Next
End With

Answer 1

如果您想绕过 VBA 并使用公式，您可以这样做。

单元格 B2：

    =LEFT(A2,5)

C2 单元格：

    =IF(LEN(A2)=9,RIGHT(A2,4),"0000")

Answer 2

解决这个问题的最简单方法之一是在原始字符串中补充大量的零，并取两个单元格的前五个字符的值：

Sub setZIPandZeros()
    Const TEN_ZEROS = "0000000000"    ' 10 times
    
    Dim ws As Worksheet
    Dim cell As Range
    Dim sLongString As String
    
    Set ws = Worksheets("Sheet1")
    
    For Each cell In ws.Range("K2:K" & ws.Cells(ws.Rows.Count, "K").End(xlUp).Row).Cells
        sLongString = Trim(cell.Text) & TEN_ZEROS
        cell.Offset(0, 1).Resize(1, 2).NumberFormat = "@"
        cell.Offset(0, 1).Resize(1, 2).Value = Array(Left(sLongString, 5), _
            Mid(sLongString, 6, 5))
    Next cell
End Sub

更新修改后的代码速度更快，并且给出的结果更接近任务描述：

Sub setZipZeros()
    Dim ws As Worksheet
    Dim rResult As Range
    Set ws = Worksheets("Sheet1")
    
    ' Addressing R1C1 is used in the formulas - If the original range
    ' is shifted to another column, you will need to change the letter
    ' of the column "K" only in this line
    Set rResult = ws.Range("K2", ws.Cells(ws.Rows.Count, "K").End(xlUp)).Offset(0, 1)
    
    ' If the columns L:M are already in text format, then instead of
    ' the results we will get the texts of formulas
    rResult.Resize(, 2).NumberFormat = "General"
    
    ' These two lines do most of the work:
    rResult.Formula2R1C1 = "=LEFT(TRIM(RC[-1])&""00000"",5)"
    rResult.Offset(0, 1).Formula2R1C1 = "=MID(TRIM(RC[-2])&""000000000"",6,4)"
    
    ' We don't know if auto-recalculation mode is on now
    ' Application.Calculation = xlAutomatic
    ActiveSheet.Calculate
    Set rResult = rResult.Resize(, 2)
    
    ' Set the text format for the cells of the result
    ' to prevent conversions "00123" to "123"
    rResult.NumberFormat = "@"
    
    ' Replace formulas with their values
    rResult.Value = rResult.Value
End Sub