从另一个工作表的单元格列替换第一行中的标题名称

Posted 2023-03-27

【中文标题】从另一个工作表的单元格列替换第一行中的标题名称

【英文标题】：Replace Headers name in the first row from the cells column of another sheet

【发布时间】：2021-06-03 00:07:20

【问题描述】：

我正在尝试在 VBA 中实现以下自动化。我有不同的表格，但标题错误。我有另一个名为“HeadersMap”的工作表，其中包含所有工作表正确标题的列表。我想要做的是，如果我打开一个“Sheet1”，那么代码应该转到“HeadersMap”工作表>检查“SheetNames”列中打开的工作表名称>检查“OriginalHeaders”列中的原始标题并复制正确“正确标题”列中的标题名称，并替换“Sheet1”中的标题。同样，如果我打开“Sheet2”，它也应该这样做。

“表 1”

	A	B	C
1	aplpe	baanann	Roange
2
3

表格“标题图”

	A	B	C
1	SheetNames	OriginalHeaders	CorrectHeaders
2	Sheet1	aplpe	Apple
3	Sheet1	baanann	Banana
4	Sheet1	Roange	Orange
5	Sheet2	sgura	Sugar
6	Sheet2	Jggaery	Jaggery
7	Sheet3	Dtergetn	Detergent
8	Sheet3	poas	Soap
9	Sheet3	Lfua	Lufa

所需结果“SHEET1”

	A	B	C
1	Apple	Banana	Orange
2
3

【问题讨论】：

何时创建工作表，或何时（每次）选择工作表？

@ChristoferWeber 当我在包含工作表“HeadersMap”的工作簿中导入此“Sheet1”时。所以有不同的工作表，如.. Sheet1、Sheet2、Sheet3 等。其中有错误的标题。我想在导入时选择 Sheet1 并比较 "HeaderMaps" 中的标题名称，替换名称并将 Sheet1 保存为正确的标题！

所以你有一个带有“HeadersMaps”工作表的工作簿，然后你从另一个工作簿导入一个新工作表？如果它被称为“Sheet1”，我们应该在 HeadersMaps 中查找 Sheet1 并替换标题，等等 Sheet2 或其他任何东西，只要名称存在于 HeadersMaps 中？我们是完全关心 OriginalHeaders，还是只是将 CorrectHeaders 复制到工作表中？

@ChristoferWeber 是的。而且我们根本不关心OriginalHeaders，需要将正确的Headers复制到Sheet中

【参考方案1】：

试试，

Sub test()
    Dim Ws As Worksheet
    Dim vDB As Variant
    Dim rngHeader As Range
    Dim i As Integer
    
    Set Ws = Sheets("HEADERSMAP")
    
    vDB = Ws.Range("a1").CurrentRegion
    
    For i = 2 To UBound(vDB, 1)
        If isHas(vDB(i, 1)) Then
            Set Ws = Sheets(vDB(i, 1))
            Set rngHeader = Ws.Rows(1)
            rngHeader.Replace vDB(i, 2), vDB(i, 3)
        End If
    Next i
End Sub
Function isHas(v As Variant) As Boolean
    Dim Ws As Worksheet
    For Each Ws In Worksheets
        If Ws.Name = v Then
            isHas = True
            Exit Function
        End If
    Next Ws
End Function

【讨论】：

在我的包含工作表“Sheet1”和“HeadersMap”的工作簿中打开。我尝试了代码，但它抛出错误“Subsript out of range”并停在“Set Ws = Sheets(vDB(i, 1))”

代码现在可以工作了！我想让它也适用于现有的工作表。就像我对 Christofer 和 VBasic2008 提到的那样，我想指定工作表名称。假设 Sheet("Fruits")。

您的代码满足了这个问题的问题！非常感谢您的宝贵贡献！亲切的问候

【参考方案2】：

正确的标题

编辑

阅读您的评论后，最好将完整代码复制到ThisWorkbook 模块（如果您坚持使用此功能）。无需添加其他模块。

---

假设工作表HeadersMap中的数据从单元格A1开始。

标准模块，例如Module1

Option Explicit

Sub correctHeaders(ws As Worksheet)
    
    Const sName As String = "HeadersMap"
    Const sFirst As String = "A1"
    
    Dim rg As Range
    Dim Data As Variant
    
    Set rg = ThisWorkbook.Worksheets(sName).Range(sFirst).CurrentRegion
    If IsNumeric(Application.Match(ws.Name, rg.Columns(1), 0)) Then
    
        Data = rg.Value
        
        Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
        Dim Result() As Variant
        Dim r As Long, j As Long
        For r = 1 To UBound(Data, 1)
            If StrComp(Data(r, 1), ws.Name, vbTextCompare) = 0 Then
                j = j + 1
                ReDim Preserve Result(1 To 2, 1 To j)
                Result(1, j) = Data(r, 2)
                Result(2, j) = Data(r, 3)
            End If
        Next r
        
        If j > 0 Then
            Set rg = ws.UsedRange.Rows(1)
            Data = rg.Value
            Dim cIndex As Variant
            For j = 1 To j
                cIndex = Application.Match(Result(1, j), Data, 0)
                If IsNumeric(cIndex) Then
                    Data(1, cIndex) = Result(2, j)
                End If
            Next j
            rg.Value = Data
        End If
    
    End If

End Sub

附加功能（您必须运行它）

Sub correctHeadersApply
    Dim ws As Worksheet
    For Each ws in Thisworkbook.Worksheets
        correctHeaders ws
    Next ws
End Sub        

ThisWorkbook 模块

Option Explicit

Private Sub Workbook_Open()
    correctHeaders ActiveSheet
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Type = xlWorksheet Then
        correctHeaders Sh
    End If
End Sub

【讨论】：

我将标准模块复制为 Module1 以及“Sub correctHeadersApply”。还将“Private Sub Workbook_Open()”和“Private Sub Workbook_SheetActivate(ByVal Sh As Object)”复制到 ThisWorkbook。我没有收到任何错误，但代码没有做任何事情！

您是否尝试过运行correctHeadersApply 过程？工作表HeadersMap 中的数据是否从单元格A1 (SheetNames) 开始？它必须从A1 开始，或者你必须找到另一种方法来定义范围（rg）。

代码有效。它不适用于现有的表格。由于代码在 ThisWorkbook 模块中，当我创建或导入新工作表时，代码有效！我们不能将代码放在 ThisWorkbook 模块中并为特定工作表手动运行它，无论是新导入的还是现有的？假设已经有一个名为“Fruits”的工作表，我想更正标题，所以我只需运行代码，选择工作表“Fruits”并更正标题。我应该在代码中的哪里添加工作表“Fruits”？谢谢

您可以使用 Workbook_SheetActivate 中的代码，就像 Christofer Weber 在他的回答中使用的那样：Workbook_NewSheet，来自动重命名。如果您想“手动”重命名工作表中的标题，请创建一个新的Sub，例如包含单行 correctHeaders ThisWorkbook.Worksheets("Fruits") 并运行它。此外，您还可以使用correctHeaders ActiveSheet（我想后者就是您要找的东西）。

我做到了，而且效果很好！非常感谢您的宝贵贡献！ :) 亲切的问候

【参考方案3】：

最低限度可能会将其放入 ThisWorkbook：

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim targetRange As Range, i As Long
Set targetRange = Worksheets("HEADERSMAP").Range("A1:A9")
i = 1
    For Each entry In targetRange
        If entry.Value = Sh.NAME Then
            Sh.Cells(1, i) = entry.Offset(, 2).Value
            i = i + 1
        End If
    Next
End Sub

如果数据看起来像您的示例。 稍后您可能希望将Range("A1:A9") 更改为查找最后一行，并将Offset(, 2) 更改为Offset(, 1)，因为“OriginalHeaders”列实际上是多余的。

模块版本类似于：

Sub headers()
Dim targetRange As Range, i As Long, Sh As Worksheet
Set Sh = Worksheets(InputBox("Enter name of sheet"))
Set targetRange = Worksheets("HEADERSMAP").Range("A1:A9")
i = 1
    For Each entry In targetRange
        If entry.Value = Sh.NAME Then
            Sh.Cells(1, i) = entry.Offset(, 2).Value
            i = i + 1
        End If
    Next
End Sub

也就是说，如果工作表的名称和列表中的项目相关。 您可以使用第二个输入框设置第二个变量，并替换 Sh.NAME 以手动从列表中选择。 像这样：

Sub headers()
Dim targetRange As Range, i As Long, Sh As Worksheet, name As String
Set Sh = Worksheets(InputBox("Enter name of sheet"))
name = InputBox("Enter name from map")
Set targetRange = Worksheets("HEADERSMAP").Range("A1:A9")
i = 1
    For Each entry In targetRange
        If entry.Value = name Then
            Sh.Cells(1, i) = entry.Offset(, 2).Value
            i = i + 1
        End If
    Next
End Sub

然后你可以手动输入witch sheet get what headers，如果你愿意的话。

【讨论】：

代码完美运行！但问题在于图纸编号。例如。更新 Sheet1 后，我将其保存并删除。当它们更新时，我会不断从工作簿中删除工作表。删除 3 张工作表后，我导入一个新工作表，excel 会将其视为 Sheet4，它不在 HeadersMap 中。而且，我不想把代码放在 ThisWorkbook 模块中，我想把它放在标准模块中。假设我导入名为“Fruits”的工作表，然后运行此代码并选择工作表“Fruit”并替换“HeaderMaps”中的标题我想将工作表名称放入代码中！

@Goku 应该很容易重新制作。我一回到我的电脑前。除非其他答案很好。

等等，如果你导入水果，并且水果在那里，它会起作用。它还是作为 Sheetx 导入的吗？是否要重命名工作表，然后运行代码？或者我到底希望我如何工作？

做了一点修改。我的意思是，你可以走得更远，做下拉菜单之类的。

终于，一切正常！非常感谢您的宝贵贡献！亲切的问候