VBA - 不要在范围内抓住标题 [英] VBA - do not grab header in range

问题描述

我有一个使用.Find方法查找标题CUTTING TOOL的代码。它打开文件中的多个文件和多个工作表。

I have code that looks for the header "CUTTING TOOL" using a .Find method. It loops through multiple files and multiple worksheets in the opening files.

我遇到了问题，当它通过一个打开文件，列下的标题为空，它将打印出标题CUTTING TOOL。它不会在初始工作表或不包含多个工作表的工作簿中执行此操作。任何想法如何解决？

I have run into the problem that when it goes through multiple worksheets in one open file and the column is empty under the header, it will print out the header, "CUTTING TOOL". It does not do this in the initial worksheet or in workbooks that do not contain multiple worksheets. Any ideas how to fix it?

'(3)
            'find CUTTING TOOL on the source sheet'
            If Not ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then
            Set hc = ws.Range("A1:M15").Find(What:="CUTTING TOOL", LookAt:=xlWhole, LookIn:=xlValues)
                Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
                If dict.count > 0 Then
                'add the values to the master list, column 3
                        Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
                        d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
                ElseIf dict = "" Then
                    StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0) = "NO CUTTING TOOLS PRESENT"
                End If
            ElseIf Not ws.Range("A1:M15").Find(What:="TOOL CUTTER", LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then ' find TOOL CUTTER on sheet
                Set hc = ws.Range("A1:M15").Find(What:="TOOL CUTTER", LookAt:=xlWhole, LookIn:=xlValues)
                    Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
                    If dict.count > 0 Then
                    'add the values to the master list, column 3
                        Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
                        d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
                    Else
                    End If                  
            Else
                If hc3 Is Nothing Then
                    StartSht.Range(StartSht.Cells(i, 3), StartSht.Cells(GetLastRowInColumn(StartSht, "C"), 1)) = "NO CUTTING TOOLS PRESENT!"
                End If
            End If

    ...
    ...
End Sub
    ...
    ...

'(8)
'get all unique column values starting at cell c
Function GetValues(ch As Range, Optional vSplit As Variant) As Object
    Dim dict As Object
    Dim rng As Range, c As Range
    Dim v
    Dim spl As Variant

    Set dict = CreateObject("scripting.dictionary")

    For Each c In ch.Parent.Range(ch, ch.Parent.Cells(Rows.count, ch.Column).End(xlUp)).Cells
        v = Trim(c.Value)
            If Not dict.exists(v) Then
                If Len(v) > 0 Then

            'exclude any info after ";"
            If Not IsMissing(vSplit) Then
                spl = Split(v, ";")
                v = spl(0)
            End If

            'exclude any info after ","
            If Not IsMissing(vSplit) Then
                spl = Split(v, ",")
                v = spl(0)
            End If
        End If
        dict.Add c.Address, v
    End If

        If Len(v) = 0 Then
            v = "none"
        End If   
    Next c
    Set GetValues = dict
End Function

'(9)
'find a header on a row: returns Nothing if not found
Function HeaderCell(rng As Range, sHeader As String) As Range
    Dim rv As Range, c As Range
    For Each c In rng.Parent.Range(rng, rng.Parent.Cells(rng.Row, Columns.count).End(xlToLeft)).Cells
        'copy cell value if it contains some string "holder" or "cutting tool"
        If Trim(c.Value) = sHeader Then
            Set rv = c
            Exit For
        End If
    Next c
    Set HeaderCell = rv
End Function

推荐答案

问题出在 GetValue 函数中。当标题下方没有值时，范围选择最终将选择空单元格加上它的标题。

The problem lies in the GetValue function. When there is no value below the header, the range selection ends up selecting the empty cell plus the heading above it.

您还没有正确实现如果Len（v）= 0然后从上一篇文章。您已将其添加到代码中的区域，其中 v 的值将永远不会被使用。

You have also not properly implemented the If Len(v) = 0 Then from a previous post. You have added it in a region of the code where the value of v will never get used.

如上所述在另一个答案中，您应该真正使用 Dictionary 的早期绑定，以便该函数可以返回一个 Dictionary 而不是对象。在使用 GetValue 函数的代码中，您使用的是：

As mentioned in another answer, you should really use early binding for the Dictionary so that the function can return a Dictionary rather than an Object. In the code that uses the GetValue function you are using this:

    Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
    If dict.Count > 0 Then
        ' do something...
    ElseIf dict = "" Then
        ' do something else...
    End If

这是一个问题，因为您的代码无法确定它是否具有字典或空字符串。但是，如果你总是返回一个字典，即使是空的，那么你可以使用：

This is a problem because your code cannot be sure if it has a dictionary or an empty string. But if you always return a dictionary, even if empty, then you can use:

    Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
    If dict.Count > 0 Then
        ' do something...
    Else Then
        ' do something else...
    End If

哪个更一致。如果代码使用 GetValue ，它总是获取一个字典，但它可能不包含任何

Which is more consistent. If the code uses GetValue, it always gets a Dictionary but it might not contain any values.

您的版本 GetValues 还有一个问题。您将单元格地址放入字典中作为关键字，但您正在根据字典测试单元格的值，以查看它是否已经存在。从你的代码看，你想要一个唯一值的字典。而不是打破使用 d.Items 的其他代码，我将更改 GetValue 函数，以便将单元格值存储在在字典中的键和值都是。

There is another problem with your version of GetValues. You are putting the cell address into the dictionary as the key but you are testing the value of the cell against the dictionary to see if it already exists. From yuor code, it looks like you want a dictionary of the unique values. Rather than break your other code that uses d.Items I will change the GetValue function so it stores the cell value in both key and value in the dictionary.

Function GetValues(ch As Range, Optional vSplit As Variant) As Scripting.Dictionary

    Dim dict As Scripting.Dictionary
    Dim dataRange As Range
    Dim cell As Range
    Dim theValue As String
    Dim splitValues As Variant

    Set dict = New Scripting.Dictionary

    Set dataRange = ch.Parent.Range(ch, ch.Parent.Cells(Rows.Count, ch.Column).End(xlUp)).Cells
    ' If there are no values in this column then return an empty dictionary
    ' If there are no values in this column, the dataRange will start at the row
    ' *above* ch and end at ch
    If (dataRange.Row = (ch.Row - 1)) And (dataRange.Rows.Count = 2) And (Trim(ch.Value) = "") Then
        GoTo Exit_Function
    End If

    For Each cell In dataRange.Cells
        theValue = Trim(cell.Value)
        If Len(theValue) = 0 Then
            theValue = "none"
        End If
        If Not dict.exists(theValue) Then

            'exclude any info after ";"
            If Not IsMissing(vSplit) Then
                splitValues = Split(theValue, ";")
                theValue = splitValues(0)
            End If

            'exclude any info after ","
            If Not IsMissing(vSplit) Then
                splitValues = Split(theValue, ",")
                theValue = splitValues(0)
            End If

            dict.Add theValue, theValue
        End If

    Next cell

Exit_Function:
    Set GetValues = dict
End Function

这篇关于VBA - 不要在范围内抓住标题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！