简体   繁体   中英

Paste as Text and Keep Leading Zero

How to Paste as Text and Keep leading zero. I am trying to convert this code to paste as text rather than value but it keeps giving me an error.

Your help will be much appreciated.

I want to keep the 0 using my below function.

https://i.stack.imgur.com/0huuJ.png

Set rngA = .NumberFormat = "@"

then tried

If ra = 1 Then rngB.Resize(, rc).Value = rngA.PasteSpecial : Exit Sub

but nothing worked

Dim rngA        As Range
    Dim rngB        As Range
    Dim r           As Range
    Dim Title       As String
    Dim ra          As Long
    Dim rc          As Long
    
    On Error GoTo skip:
    
    Title = "Copy Visible To Visible"
    Set rngA = Application.Selection
    Set rngA = Application.InputBox("Select Range To Copy Then click OK:", Title, rngA.Address, Type:=8)
   
    
    Set rngB = Application.InputBox("Select Range To Paste (select the first cell only):", Title, Type:=8)
    Set rngB = rngB.Cells(1, 1)
    Application.ScreenUpdating = False
    
    ra = rngA.Rows.Count
    rc = rngA.Columns.Count
    If ra = 1 Then rngB.Resize(, rc).Value = rngA.Value: Exit Sub
    
    Set rngA = rngA.Cells(1, 1).Resize(ra, 1)
    
    For Each r In rngA.SpecialCells(xlCellTypeVisible)
        rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
        Do
            Set rngB = rngB.Offset(1, 0)
        Loop Until rngB.EntireRow.Hidden = False
    Next
    
    Application.GoTo rngB
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Exit Sub
skip:
    If Err.Number <> 424 Then
        MsgBox "Error found: " & Err.Description
    End If
    
    Application.ScreenUpdating = True
    Application.CutCopyMode = False

Change this ...

rngB.Resize(1, rc).Value = r.Resize(1, rc).Value

... to this ...

rngB.Resize(1, rc).Value = "'" & r.Resize(1, rc).Value

Adding an apostrophe in front will instruct Excel to ignore what it thinks it should do for you and will preserve it's textual value and represent it as a string.

I can imagine you will have done this before in a cell manually. This also works in VBA and is a nice, easy way to achieve what you want.

Change this:

rngB.Resize(1, rc).Value = r.Resize(1, rc).Value

to this:

With rngB.Resize(1, rc)
    .NumberFormat = "@"
    .Value = r.Resize(1, rc).Value
End With

Edit #1

Your code suggests that you only skip hidden rows but ignore any hidden columns. It's faster to copy larger arrays in one go and if there is no hidden row then we don't need to read/write row by row.

I would replace this:

ra = rngA.Rows.Count
rc = rngA.Columns.Count
If ra = 1 Then rngB.Resize(, rc).Value = rngA.Value: Exit Sub

Set rngA = rngA.Cells(1, 1).Resize(ra, 1)

For Each r In rngA.SpecialCells(xlCellTypeVisible)
    rngB.Resize(1, rc).NumberFormat = "@"
    rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
    Do
        Set rngB = rngB.Offset(1, 0)
    Loop Until rngB.EntireRow.Hidden = False
Next

with this:

If rngA.Areas.Count > 1 Then Set rngA = rngA.Areas(1)
ra = rngA.Rows.Count
rc = rngA.Columns.Count
Set rngB = rngB.Resize(1, rc)

Dim i As Long: i = 0
Dim firstVisibleRow As Long: firstVisibleRow = 0
Dim lastVisibleRow As Long: lastVisibleRow = 0
Dim rCount As Long
Dim rngWrite As Range
Dim rngRead As Range
Dim isHidden As Boolean

For Each r In rngA.Rows
    i = i + 1
    isHidden = r.EntireRow.Hidden
    If Not isHidden Then
        If lastVisibleRow = 0 Then firstVisibleRow = i
        lastVisibleRow = i
    End If
    If isHidden Or i = ra Then
        If lastVisibleRow > 0 Then
            Set rngWrite = rngB.Rows(firstVisibleRow)
            If lastVisibleRow > firstVisibleRow Then
                rCount = lastVisibleRow - firstVisibleRow + 1
                Set rngWrite = rngWrite.Resize(rCount)
                Set rngRead = r.Resize(rCount).Offset(-rCount + IIf(isHidden, 0, 1))
            ElseIf isHidden Then
                Set rngRead = rngA.Rows(i - 1)
            Else
                Set rngRead = r
            End If
            rngWrite.NumberFormat = "@"
            rngWrite.Value = rngRead.Value
        End If
    End If
    If isHidden Then lastVisibleRow = 0
Next r

The code is longer but more efficient.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM