VBA - 格式名称

Question

我希望有人可以帮我解决我的困境。由于系统软件限制，我需要将所有代码放在一个宏中。

1。）取Q列，其名称格式为＆＃34; last，first ＆＃34;并使用text to column将其分解（某些名称包含首字母，这就是我使用text to column的原因） 2.）包含用于关闭出现的消息框的代码＆＃34;是否要替换目标单元格的内容？＆＃34; 3.）删除除＆＃34; last＆＃34;之外生成的所有列。 ＆安培; ＆＃34;第一＆＃34;名称。 4.）连接两列，以便它们读取Firstname Lastname 5.）自动填写最后一行。 6.）将特殊值粘贴到相邻列中，并使用该函数删除旧列。

我尝试录制代码，但似乎我所需要的内容无法录制并需要编写。

我的注意力是让我的工作步骤，从我的录音机和论坛中提取代码，并认为我需要一个训练有素的眼睛来整理我的混乱：

Application.DisplayAlerts = False

Columns("Q:Q").Select
Selection.TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
    Semicolon:=True, Comma:=True, Space:=True, Other:=False, FieldInfo:= _
    Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
    True

Application.DisplayAlerts = False

Columns("U:U").Select
Selection.Delete Shift:=xlToLeft
Columns("S:T").Select
Selection.ClearContents
Range("S2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1], "" "", RC[-2])"
Range("S2").Select
Selection.AutoFill Destination:=Range("S2:500")
Range("S2:S42").Select
Columns("S:S").Select
Selection.Copy
Columns("T:T").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("T1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Lead Recruiter"
Columns("Q:S").Select
Selection.Delete Shift:=xlToLeft

感谢Ron，我能够让msg框消失。现在它突破了界线：

Selection.AutoFill Destination:=Range("S2:500")

如何将此更新自动填充到最后一行？数据在Q栏中。非常感谢任何见解。

Answer 1

我的假设

1. 数据位于第Q栏
2. 列Q
后没有数据
3. 需要在R列中生成结果。如果要替换Q列中的值，请参阅CODE 2.

这是我能想到的最短代码。

代码1

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find the last row in a column
        lRow = .Range("Q" & .Rows.Count).End(xlUp).Row

        '~~> Enter the formula in the complete column
        .Range("R1:R" & lRow).Formula = "=IFERROR(MID(Q1,FIND("","",Q1,1)+2,FIND("" "",Q1,FIND("","",Q1,1)+2)-" & _
                                        "(FIND("","",Q1,1)+2)),MID(Q1,FIND("","",Q1,1)+2,LEN(Q1)-FIND("","",Q1" & _
                                        ",1)+2+1)) & "" "" & LEFT(Q1,FIND("","",Q1,1)-1)"

        '~~> Convert all formulas to values in one go
        .Range("R1:R" & lRow).Value = .Range("R1:R" & lRow).Value
    End With
End Sub

<强>截图



代码2

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find the last row in a column
        lRow = .Range("Q" & .Rows.Count).End(xlUp).Row

        '~~> Enter the formula in the complete column
        .Range("R1:R" & lRow).Formula = "=IFERROR(MID(Q1,FIND("","",Q1,1)+2,FIND("" "",Q1,FIND("","",Q1,1)+2)-" & _
                                        "(FIND("","",Q1,1)+2)),MID(Q1,FIND("","",Q1,1)+2,LEN(Q1)-FIND("","",Q1" & _
                                        ",1)+2+1)) & "" "" & LEFT(Q1,FIND("","",Q1,1)-1)"

        '~~> Convert all formulas to values in one go
        .Range("R1:R" & lRow).Value = .Range("R1:R" & lRow).Value

        '~~> Delete Col Q so R moves to Q
        .Columns(17).Delete Shift:=xlToLeft
    End With
End Sub



来自评论的跟进

这是你在尝试的吗？

Sub FormatPushReport()
    Dim ws As Worksheet
    Dim lRow As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws

        .Range("R:R,U:U").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("R1").Value = .Range("Q1").Value
        .Range("V1").Value = .Range("U1").Value

        '~~> Find the last row in a column
        lRow = .Range("Q" & .Rows.Count).End(xlUp).Row


        '~~> Enter the formula in the complete column
        .Range("R2:R" & lRow).Formula = "=IFERROR(MID(Q2,FIND("","",Q2,1)+2,FIND("" "",Q2,FIND("","",Q2,1)+2)-" & _
                                        "(FIND("","",Q2,1)+2)),MID(Q2,FIND("","",Q2,1)+2,LEN(Q2)-FIND("","",Q2" & _
                                        ",1)+2+1)) & "" "" & LEFT(Q2,FIND("","",Q2,1)-1)"

        .Range("V2:V" & lRow).Formula = "=IFERROR(MID(U2,FIND("","",U2,1)+2,FIND("" "",U2,FIND("","",U2,1)+2)-" & _
                                        "(FIND("","",U2,1)+2)),MID(U2,FIND("","",U2,1)+2,LEN(U2)-FIND("","",U2" & _
                                        ",1)+2+1)) & "" "" & LEFT(U2,FIND("","",U2,1)-1)"

        '~~> Convert all formulas to values in one go
        .Range("R2:R" & lRow).Value = .Range("R2:R" & lRow).Value
        .Range("V2:V" & lRow).Value = .Range("V2:V" & lRow).Value

        .Columns(18).Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        .Columns(22).Replace What:="#VALUE!", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        .Range("Q:Q,U:U").Delete Shift:=xlToLeft
    End With
End Sub

<强>截图