这里的新手......多次使用这个网站来获得答案,但找不到我最新的挑战。
我想创建一个宏,用户将在一个工作表中选择(标记/取消标记)字段名称,运行将重新排序的宏,在另一个工作表上格式化其他数据并删除用户没有的列想看。
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