VBA - do not grab header in range

后端 未结 1 735
执笔经年
执笔经年 2021-01-29 06:21

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.

I have run int

相关标签:
1条回答
  • 2021-01-29 06:48

    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.

    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.

    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
    

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

    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
    
    0 讨论(0)
提交回复
热议问题