Excel宏删除基于用户首选项的列

时间:2017-07-20 17:28:21

标签: excel excel-vba vba

这里的新手......多次使用这个网站来获得答案,但找不到我最新的挑战。

我想创建一个宏,用户将在一个工作表中选择(标记/取消标记)字段名称,运行将重新排序的宏,在另一个工作表上格式化其他数据并删除用户没有的列想看。

Ex:用户希望查看列数据元素A,B和B组。 D但不是C,所以他们在第一张中标记这三行,并将dataC留空。

Sheet1
Field Name(Column A)    Include? (Column B)
DataA                    Y
DataB                    
DataC                    Y
DataD                    Y

宏运行并创建一个sheet2,它保留标准导出文件中的所有字段...目前有50多个字段但是对于这个例子,我们说只有4个字段

理想情况下,结果将是仅包含以下列的sheet2。

DataA  DataB  DataC

我已经创建了一个执行格式化的宏。我可以在最后根据sheet1中的信息删除某些列吗?

非常感谢任何和所有帮助。

谢谢!

-------------------这是我想整合的一大堆宏,因此我的问题。我没有尝试维护不同的宏并要求人们从源系统中导出某些字段,而是认为自动导出数据会更容易,人们只需标记他们需要的内容并运行宏。感谢

Sub ARMImport()
'
' Upload1 Macro
'

'
    Dim FileToOpen
    FileToOpen = Application.GetOpenFilename
    If FileToOpen <> False Then
    Workbooks.OpenText FileToOpen, Origin:= _
        65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=True, _
        Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
        3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10 _
        , 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
        Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array( _
        23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), _
        Array(30, 1), Array(31, 1)), TrailingMinusNumbers:=True
        Else
        MsgBox "No file selected. Macro cancelled."
        Exit Sub
    End If
    ActiveWorkbook.Unprotect ("deleted")
    ActiveSheet.Unprotect ("deleted")
    Rows(Range("J" & Rows.Count).End(xlUp).Row + 1 & ":" & Rows.Count).Delete
    Columns("K:JA").Select
    Selection.Delete Shift:=xlToLeft
    Range("J8").Activate
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    Columns("H:J").Select
    Range("J8").Activate
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    Range("K8").Select
    ActiveCell.FormulaR1C1 = "#"
    With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("L8").Select
    ActiveCell.FormulaR1C1 = "Entered By" & vbCrLf & "(f_boX.entered_by)"
    Range("E4").Select
    Selection.Copy
    Range("L9").Select
    ActiveSheet.Paste
    Range("M8").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Box Status" & vbCrLf & "(f_box.status)"
    Application.CutCopyMode = False
    Range("M9").Select
    ActiveCell.FormulaR1C1 = "A"
    Range("M10").Select
    Range("K9").Value = InputBox("redacted question?")
    Dim LR As Long
    LR = Range("J" & Rows.Count).End(xlUp).Row
        Range("L9:M9").Select
        Selection.Copy
        Range("L9:M" & LR).Select
        ActiveSheet.Paste
    LRZ = Range("J" & Rows.Count).End(xlUp).Row
        Range("K9").Select
        Selection.AutoFill Destination:=Range("K9:K" & LRZ), Type:=xlFillSeries
    Rows("1:8").Select
    Range("A8").Activate
    Selection.Delete Shift:=xlUp
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Vendor Barcode" & vbCrLf & "(f_box.external_name)"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "User Box Number" & vbCrLf & "(f_box.cust_user_box_number)"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Department" & vbCrLf & "(f_box.office_id)"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Description" & vbCrLf & "(f_box.notes)"
    With ActiveCell.Characters(Start:=1, Length:=11).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "additional Description" & vbCrLf & "(f_box.notes2)"
    With ActiveCell.Characters(Start:=1, Length:=22).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "From Date" & vbCrLf & "(f_box.cust_from_date)"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "To Date" & vbCrLf & "(f_box.cust_to_date)"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Box Type" & vbCrLf & "(f_box.box_type)"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Media Type" & vbCrLf & "(f_box.cust_media_type)"
    With ActiveCell.Characters(Start:=1, Length:=10).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Category" & vbCrLf & "(category_import_id [fullcode] )"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "#"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "BoX owner" & vbCrLf & "(f_boX.owner )"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Box Status" & vbCrLf & "(f_box.status)"
    Columns("K:K").Select
    Selection.Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Columns("L:L").Select
    Selection.Copy
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Entered By" & vbCrLf & "(f_boX.entered_by)"
    Columns("A:A").Select
    Selection.Copy
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Box Number" & vbCrLf & "f_box.box_num"
    Columns("D:D").Select
    Selection.Copy
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Range("G1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Foreign Barcode" & vbCrLf & "(Barcode)"
    Columns("P:P").Select
    Selection.Cut
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Cells.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Dim LRF As Long
    LRF = Range("A" & Rows.Count).End(xlUp).Row
        Range("A1:P" & LRF).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Columns("P:P").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Storage Location" & vbCrLf & "(f_box.warehouse_id)"
    With ActiveCell.Characters(Start:=1, Length:=16).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("P2").Value = InputBox("redacted question?")
    Dim LRST As Long
    LRST = Range("A" & Rows.Count).End(xlUp).Row
        Range("P2").Select
        Selection.AutoFill Destination:=Range("P2:P" & LRST)
    Range("F2").Value = InputBox("What is the Department ID?")
    Dim LRDI
    LRDI = Range("A" & Rows.Count).End(xlUp).Row
        Range("F2").Select
        Selection.AutoFill Destination:=Range("F2:F" & LRDI)
    Sheets("Retention Schedule").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    Sheets("Instructions").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    Rows("2:8").Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
    MsgBox "Macro Completed"
End Sub

0 个答案:

没有答案