Question

我需要一个VBA宏来执行以下操作：

这部分工作正常，我希望它在sheet1上创建一个新列，并将其命名为header name，然后为其着色。

Columns("P:P").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("P1").Select
ActiveCell.FormulaR1C1 = "Header Name"
Range("P1").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 15773696
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

但是这部分我想在sheet2上查找标题名称而不仅仅是列C（因为有时列位置可能会改变）

Range("P2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],Sheet2!C[-15]:C[-14],2,FALSE)"
Range("P2").Select
Selection.AutoFill Destination:=Range("P2:P" & Cells(Rows.Count, "X").End(xlUp).Row)

基本上这就是我想要它做的事情：

在工作表1上的

在P中创建一个新列，并将其命名为＃34;标题名称＆＃34;然后我希望它在表1上按列x（标题2）进行查找（如果能够通过名称）并将其与sheet2列a（标题02）进行比较，并在B列（标题3）中给出匹配信息< / p>

我已使用此vlookup =VLOOKUP(X2,Sheet2!A:B,2,FALSE)但我希望它们不是x,a,b的标题名称，并搜索整个工作表以查找标题名称。

列X名称：标题2
列A名称：标题02
B列名称：标题3
列P名称：标题名称

Answer 1

如果你改变它可能会有效：

ActiveCell.Formula = "=vlookup(X" & ActiveCell.row & ",Sheet2!A:B,2,0)"

为：

ActiveCell

但话虽如此，请注意.Select和Sub test3() 'use the Header2sheet1column variable to hold the column number that "Header 2" is found in on sheet 1 Dim Header2sheet1column As Long 'search for "Header 2" across row 1 of sheet1 and remember the column number Header2sheet1column = Application.Match("Header 2", ThisWorkbook.Sheets("Sheet1").Range("$1:$1"), 0) 'use the Header2sheet2column variable to hold the column number that "Header 2" is found in on sheet 2 Dim Header2sheet2column As Long 'search for "Header 2" across row 1 of sheet2 and remember the column number Header2sheet2column = Application.Match("Header 2", ThisWorkbook.Sheets("Sheet2").Range("$1:$1"), 0) 'use the lookuprange variable to hold the range on sheet2 that will be used in the vlookup formula Dim lookuprange As Range 'using With just so I don't have to type ThisWorkbook.Sheets("Sheet2") a bajillion times in the next couple lines With ThisWorkbook.Sheets("Sheet2") 'set lookuprange variable - will start at column that "Header 2" is found on sheet 2 and will go to last row/column of the sheet 'having extra columns at the end of your vlookup formula isn't going to hurt. the Set lookuprange = .Range(.Cells(1, Header2sheet2column), .Cells(.Rows.Count, .Columns.Count)) 'put formula into Cell P2 on sheet1 ThisWorkbook.Sheets("Sheet1").Range("P2").Formula = "=vlookup(" & ThisWorkbook.Sheets("Sheet1").Cells(2, Header2sheet1column).Address(RowAbsolute:=False) & ",Sheet2!" _ & lookuprange.Address & "," _ & Header2sheet2column & ",0)" End With 'using With again just so I don't have to type ThisWorkbook.Sheets("Sheet1") a bajillion times in the next couple lines With ThisWorkbook.Sheets("Sheet1") 'fill formula in column P down to the row that the column .Range("P2").AutoFill Destination:=.Range("P2:P" & .Cells(.Rows.Count, Header2sheet1column).End(xlUp).Row) End With End Sub。您可以查看How to Avoid Using Select in VBA Macros

编辑：我已修改/添加到代码中，以考虑您对数据列所在位置的灵活性需求。

{{1}}

Answer 2

最好使用使用每列标题创建的命名范围。然后你的vlookup可以引用名称而不是单元格引用。

要了解如何开始录制宏，然后选择列和插入 - 名称 - 创建。每次电子表格更改时，您都可以调整宏以重新创建名称。 vlookup不需要更改，因为无论它们在哪里都会指向命名范围。

Answer 3

我远不是VBA专家。 VBA的两件事情直到最近一直困扰着我。

“存储为文本的数字”错误
按第一行“名称”查找列，而不是“列字母”

我在宏中使用它来复制＆amp;重新排序新工作表中的列：

    Sub ColumnReorder()
    '**********************************************************
    'Paste this macro into the Workbook of each new "Employee_List_Weekly_Update"
    'Functionality:
    '1. Column order in the "Employee_List_Weekly_Update" worksheet changes fairly often. 
    '   The macro will find each column by header name,
    '   select that column and copy it to the new sheet.
    '2. The macro also converts "Employee ID#" to a number,
    '   removing the "Number saved as Text" error.
    '**********************************************************
    'Create new sheet
        Sheets.Add.Name = "Roster_Columns_Reordered"

    'Repeat for each column or range - For each new section change Dim letter
    'Find Column in "Employee_List_Weekly_Update" - Copy it - Paste it in "Roster_Columns_Reordered" - Employee ID#
        Dim a As Integer
        Sheets("Employee_List_Weekly_Update").Select
        Set rngData = Range("A1").CurrentRegion
        a = Application.WorksheetFunction.Match("Employee ID#", Range("A1:BB1"), 0)
        Columns(a).Select
        Selection.Copy

        Sheets("Roster_Columns_Reordered").Select
        Range("A1").Select
        ActiveSheet.Paste
    'Use TextToColumns to convert "Number Stored as Text "
        Selection.TextToColumns _
          Destination:=Range("A:A"), _
          DataType:=xlDelimited

    'Find Column in "Employee_List_Weekly_Update" - Copy it - Paste it in "Roster_Columns_Reordered" - Name
        Dim b As Integer
        Sheets("Employee_List_Weekly_Update").Select
        Set rngData = Range("A1").CurrentRegion
        b = Application.WorksheetFunction.Match("Name", Range("A1:BB1"), 0)
        Columns(b).Select
        Selection.Copy

        Sheets("Roster_Columns_Reordered").Select
        Range("B1").Select
        ActiveSheet.Paste

    'Go to "Roster_Columns_Reordered" - Add AutoFilter - Freeze Top Row
        Rows("1:1").Select
        Selection.AutoFilter
        With ActiveWindow
          .SplitColumn = 2
          .SplitRow = 1
        End With
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        Range("A1").Select

    End Sub

Answer 4

嗯，不知何故感觉很难把它丢掉，这是我做这份工作的宝贝。但我所能做的就是感谢堆栈溢出和所有社区所做的一切，所以这里是：

请注意！我用字典。要使字典工作，请在VBA编辑器中转到工具＆gt;引用。在弹出窗口中向下滚动到“Microsoft Scripting Runtime”并选中该框并单击“确定”。

Option Base 1

Sub TransferData()

    Dim Data()         As Variant
    Dim dataSheet      As String
    Dim resultSheet   As String
    Dim headingIndexes As New Dictionary

    dataSheet = "Data"
    dataStartCell = "A1"
    resultSheet = "Result"
    Data() = Sheets(dataSheet).Range(dataStartCell).CurrentRegion.Value

    Call GetHeadingIndexes(Data(), headingIndexes)
    Call Transfer(Data(), headingIndexes, resultSheet)

End Sub

Sub GetHeadingIndexes(ByRef Data() As Variant, ByRef headingIndexes As Dictionary)

    'Creates a dictionary with key-value pairs
    '
    'Creates a dictionary structure with key-value pairs resembling a table:
    '             [Column Heading] | [Column Index]
    '            "Actual/Forecast" | 1
    '                      "Brand" | 2
    ' "Division/ Line of Business" | 3
    '
    'Now it is easy and quick to find the column index based on column heading.

    Dim i As Integer

    For i = 1 To UBound(Data(), 2)                    
        headingIndexes.Add Data(1, i), i     'Make key-value pairs out of column heading and column index
    Next i

End Sub

Sub Transfer(ByRef Data() As Variant, ByRef headingIndexes As Dictionary, resultSheet As String)

    Application.ScreenUpdating = False

    Dim resultColumnHeading As String
    Dim resultSheetColumnNumber As Integer
    Dim dataColumnNumber As Integer
    Dim row As Integer

    'Loop through columns in result sheet. Assumes you have 16 columns
    For resultSheetColumnNumber = 1 To 16

        'Find the correct column in Data()
        resultColumnHeading = resultSheet.Cells(1, resultSheetColumnNumber)
        dataColumnNumber = headingIndexes(resultColumnHeading)

        For row = 2 To UBound(Data(), 1)

            'Transfer data from Data() array to the cell in resultSheet
            'Note, referencing each cell like this is really slow, it is better to create a resultArray similar to the data array (called Data() in this example). However, explaining all the nuances would take a one hour phone call, and gets far from the question at hand)
            resultSheet.Cells(row, resultSheetColumnNumber) = Data(row, dataColumnNumber)

        Next row

    Next resultSheetColumnNumber

    Application.ScreenUpdating = True

End Sub

按标题名称而不是列

4 个答案: