由头名不列search的Excel VBA

我需要下面的VBAmacros：

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

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中创build一个新列，并将其命名为“标题名称”，然后我希望它在表单1上的列x（标题2）上进行查找（如果可以的话，按名称），并将其与sheet2列a 02）并给我B栏中的匹配信息（标题3）

我已经使用了这个vlookup =VLOOKUP(X2,Sheet2!A:B,2,FALSE)但我希望它们是不是x,a,b标题名称x,a,b并search整个表单以查找标题名称。

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

Answer 1

如果你改变它可能会工作：

 ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],Sheet2!C[-15]:C[-14],2,FALSE)" 

至：

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

但是，这是说，小心与ActiveCell和。select。 您可能想了解如何避免在VBAmacros中使用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 

Answer 2

您最好使用使用每列的标题创build的命名范围。 然后你的vlookup只能引用名字而不是单元格引用。

要想知道如何做到这一点，开始录制一个macros，然后select你的列和插入 – 名称 – 创build。 每当电子表格发生变化时，您都可以调整macros来重新创build名称。 该vlookups不需要改变，因为他们将指向所指定的范围，无论他们在哪里。

Answer 3

我远离VBA专家。 VBA中的两件事直到最近都困扰了我很长一段时间。

1. “数字存储为文本”错误
2. 按第一行查找列'姓名'而不是'列字母'

我在macros中使用这个来复制和重新排列新表中的列：

  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编辑器中findTools> References。 在popup窗口中向下滚动到“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