如何应用 InStr 将标题名称与名称数组匹配？

Question

我的宏应该将标题名称与名称数组匹配。

• 如果为真，则省略
• 如果不是，则将第二行到最后一行的值设置为客户

最初，我在“Else”部分设置了客户值，但宏却按照预期的方式反其道而行之 - 仅更改了数组值上的单元格。这对我来说没有意义，因为我已经将我的 InStr 函数设置为正输出但是我已经将指令放在匹配部分

在 70 个变量中，有 67 个变量符合预期，3 个变量被命名为 Customer，其中少数变量没有从第二个到最后一个，例如只有第二个，或者只有少数几个。

Sub test2()
    
    Dim HeaderRow As Range
    Dim HeaderName As String
    
    HeaderName = Join(Array("ID", "GENDER", "REVENUE"))

    Set HeaderRow = Range(Cells(1, 1), Cells(1, 1).End(xlToRight))
    
    For Each Header In HeaderRow
    
        Debug.Print Header
        Debug.Print HeaderName
        If InStr(1, HeaderName, Header.Value, vbTextCompare) = 0 Then
            Range(Cells(2, Header.Column).Address, Cells(Cells(Rows.Count, Header.Column).End(xlUp).Row, Header.Column).Address).Value2 = "Customer"
        Else
                
        End If
        
    Next Header
    
End Sub

例如，BD 列是它应该是的，所有这些列都有间隙，但 BD、BF、BG、BO 是好的（该特定文件上的 1-59 行，其余的则不是）。

加上前面提到的一些内容 - 有时标题设置为客户和第一行，仅此而已。

新的 HeaderRow 给了我不匹配，当我更改为 ws.Range 最初它只获得第一列，就像那不是拖动 xlToLeft

Answer 1

只需遍历所有工作表For Each ws In ThisWorkbook.Worksheets 并确保所有Range、Cells、Rows 和Colums 对象都被ws.Range 等工作表引用。

Option Explicit

Public Sub test2()

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets 'loop all worksheets
        Dim HeaderName As String
        HeaderName = Join(Array("ID", "GENDER", "REVENUE"))
        
        Dim HeaderRow As Range
        Set HeaderRow = ws.Range(ws.Cells(1, 1), ws.Cells(1, 1).End(xlToRight))
    
        Dim Header As Variant
        For Each Header In HeaderRow
            Debug.Print Header
            Debug.Print HeaderName
            
            If InStr(1, HeaderName, Header.Value, vbTextCompare) = 0 Then
                ws.Range(ws.Cells(2, Header.Column), ws.Cells(ws.Rows.Count, Header.Column).End(xlUp)).Value2 = "Customer"
            End If
        Next Header
    Next ws

End Sub

---

注意Range 对象可以将Cells 作为参数，不需要Address，因此您可以缩短它

Range(Cells(2, Header.Column).Address, Cells(Cells(Rows.Count, Header.Column).End(xlUp).Row, Header.Column).Address).Value2 = "Customer"

到

Range(Cells(2, Header.Column), Cells(Rows.Count, Header.Column).End(xlUp)).Value2 = "Customer"

---

根据 cmets 的想法

如果您的标头发生更改，则意味着 ws.Cells(ws.Rows.Count, Header.Column).End(xlUp) 将在标头处结束，因为下面没有数据。所以这个范围

ws.Range(ws.Cells(2, Header.Column), ws.Cells(ws.Rows.Count, Header.Column).End(xlUp)).Value2 = "Customer"

实际上是从第 2 行转到第 1 行。为了防止这种情况，您需要将其拆分并测试：

Dim LastCellInCol As Range
Set LastCellInCol = ws.Cells(ws.Rows.Count, Header.Column).End(xlUp)

If LastCellInCol.Row >= 2 Then 'only change if there is data in the column
    ws.Range(ws.Cells(2, Header.Column), LastCellInCol).Value2 = "Customer"
End If

---

如果空白应填充到所有列的最后一行

Option Explicit

Public Sub test2()

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets 'loop all worksheets
        Dim HeaderName As String
        HeaderName = Join(Array("ID", "GENDER", "REVENUE"))
        
        Dim LastUsedCell As Range  'find last used cell of ALL columns
        Set LastUsedCell = Nothing 'initialize (because inside loop)
        Set LastUsedCell = ws.UsedRange.Find("*", , , , xlByRows, xlPrevious)
        
        If Not LastUsedCell Is Nothing Then 'prevent error on empty sheets
            Dim HeaderRow As Range
            Set HeaderRow = ws.Range(ws.Cells(1, 1), ws.Cells(1, ws.Cells.Columns.Count).End(xlToLeft))
        
            Dim Header As Variant
            For Each Header In HeaderRow
                If InStr(1, HeaderName, Header.Value, vbTextCompare) = 0 Then
                    ws.Range(ws.Cells(2, Header.Column), ws.Cells(LastUsedCell.Row, Header.Column)).Value2 = "Customer"
                End If
            Next Header
        End If
    Next ws

End Sub