Question

编辑：@TimWilliams我编辑了如下代码，但它现在根本没有运行。有什么想法吗？

Sub Item_Fix()

Dim rng As Range, col As Range, arr
Dim sht As Worksheet, c As Range, tmp

On Error Resume Next 'in case user cancels
Set rng = Application.InputBox( _
            Prompt:="Please select the Items to update. " & _
                    " (e.g. Column A or Column B)", _
            Title:="Select Range", Type:=8)

On Error GoTo 0

  '  Set hdr = Application.InputBox( _
  '              Prompt:="Does your selection contain headers?", _
  '              Title:="Header Option")

hdr = MsgBox("Does your selection contain a header?", vbYesNo + vbQuestion, "Header Option")

If rng Is Nothing Then Exit Sub

If rng.Columns.Count > 1 Then
    MsgBox "Please select only a single column!", vbExclamation
    Exit Sub
End If

Set sht = rng.Parent
Set col = sht.Range(sht.Cells(2, rng.Column), _
                    sht.Cells(sht.Rows.Count, rng.Column).End(xlUp))

Application.ScreenUpdating = False
If hdr = vbYes Then
    For Each c In col.Cells
    tmp = Trim(c.Value)
    If Len(tmp) > 0 And Len(tmp) < 9 And Row > 1 Then
        c.NumberFormat = "@"
        c.Value = Right("000000000" & tmp, 9)
    End If
Next c
End If
If hdr = vbNo Then
    For Each c In col.Cells
    tmp = Trim(c.Value)
    If Len(tmp) > 0 And Len(tmp) < 9 Then
        c.NumberFormat = "@"
        c.Value = Right("000000000" & tmp, 9)
    End If
Next c
Application.ScreenUpdating = True
End If
End Sub

我试图编写一个将前导零插入用户指定的列的函数。老实说，我希望这能像Excel菜单数据＆gt;删除重复项选项。我想点击一个菜单按钮，然后选择我的范围并让它发挥作用，不幸的是我在尝试推断已选择的列时仍然遇到错误。除了这个问题，它应该工作正常。我的代码如下。任何帮助将不胜感激！

Sub Item_Fix()
'Set Item = Application.InputBox("Select the range that contains the Items").Column
Set IC = Application.InputBox(Prompt:= _
                "Please select the Range of Items.  (e.g. Column A or Column B)", _
                    Title:="SPECIFY RANGE", Type:=8).Column
'Set Items = vRange.Column
Set Items = IC.Column
Lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Items.EntireColumn.Offset(0, 1).Insert
For i = 2 To Lastrow
Cells(i, Items + 1).Formula = "=Text(" & Cells(i, Items) & ",""000000000"")"
Next i
NewColumn = Items + 1
NewColumn.EntireColumn.Copy
Items.PasteSpecial xlPasteValues
NewColumn.EntireColumn.Delete
End Sub

Answer 1

让用户选择一组单元格来接收程序。 InputBox method似乎是一个额外的步骤，也是工作流程的障碍。

Sub make_DUNS_number()
    Dim duns As Range, tmp As String
    For Each duns In Selection
        'possible error control on non-numeric values
        'if isnumeric(duns.value2) then
            tmp = Right("000000000" & Format(duns.Value2, "000000000;@"), 9)
            duns.NumberFormat = "@"
            duns.Value2 = tmp
        'end if
    Next duns
End Sub

有了这个，你应该没有麻烦添加到QAT。有关详细信息，请参阅Add Buttons to the Quick Access Toolbar and Customize Button Images。

从Excel VBA中的用户定义范围中导出列

1 个答案: