VLookup字母数字值-删除行

时间:2020-11-30 09:22:42

I'm really struggling with a VLookup situation right now. I'm trying to do something that is really over my head, but I think that with a little help I just might be able to do it.

我现在真的很纠结于VLookup的情况。我试着做一些超出我想象的事情,但是我想,如果有一点点帮助,我可能就能做到。

  1. For starters, I created a separate sheet with a table so I can give a number to some letters so I may quantify their value.
  2. 首先,我创建了一个单独的表格和一个表格,这样我可以给一些字母一个数字,这样我可以量化它们的价值。

VLookup字母数字值-删除行

  1. With this information, I would like to elaborate a VBA formula that would be able to check a table for those letter in a column (with a number) and delete every row that would present a letter value lower than the inputed Letter's given number. (Ignore the Ns in column I)
  2. 有了这些信息,我想详细说明一个VBA公式,它可以检查列中的字母(带有数字),并删除每一行中出现的字母值低于输入字母的给定数字的值。(忽略列I中的Ns)

VLookup字母数字值-删除行]

]

  1. What I have so far is something like this:

    到目前为止,我所拥有的是这样的东西:

    Sub DeletarIndices()
    
        indice = InputBox("Digite o IC/IV Desejado", "GBG Pneus")
    
        Set planilhaV = Sheets("IV")
        Dim vValores As String
        sResult = Application.VLookup("Y", planilhaV.Range("A2:B11"), 2)
    
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        Dim i As Long
        For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
            If Not (Range("A" & i).Value > sResult) Then
                Range("A" & i).EntireRow.Delete
            End If
        Next i
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    
    End Sub
    

What happens is that when I run the code, a inputbox opens and asks for a value that will be used in the code. The letter will be converted in to a number and will be used as a comparison to delete lower values. But... Right here:

当我运行代码时,会打开一个inputbox并请求一个将在代码中使用的值。这封信将被转换成一个数字,作为删除较低值的比较。但是…在这里:

If Not (Range("A" & i).Value > sResult) Then

The letter is still a number, so when it checks the table, only numbers lower than the value will be deleted, not the letters with lower values. What I need is exactly that. That letters get analyzed and the rows deleted, not numbers.

字母仍然是一个数字,所以当它检查表时,只会删除小于该值的数字,而不会删除值较低的字母。我需要的就是这个。这些字母被分析,行被删除,而不是数字。

Thank you to anyone that may help me with this!

谢谢所有能帮助我的人!

2 个解决方案

#1


1  

Assuming that your order of priority for the letters is always alphabetical, you don't need to convert letters to numbers for this, you can simply compare letter to letter. I would also note that your way to determine the last row (Range("A" & Rows.Count).End(xlUp).Row) is not good practice, I suggest you find a more reliable method.

假设字母的优先顺序总是按字母顺序排列,你不需要把字母转换成数字,你可以简单地把字母和字母进行比较。我还要注意,您确定最后一行(Range(“A”& row . count). end (xlUp). row)的方法并不是很好的实践,我建议您找到一个更可靠的方法。

Assuming your data is presented as you have shown - with data in column H as a 3-character code where the letter is the last character (e.g. "91B", "89D", etc.) - lets go through step by step: (note there is no lookup worksheet planilhaV any more)

假设您的数据显示为您所显示的——在H列中显示的数据为3字符代码,其中字母是最后一个字符(例如:“91B”、“89D”等)——让我们一步一步地进行:(注意,不再有查找工作表planilhaV)

1) Declare our variables

1)声明变量

Dim indice As String   ' To hold our user input letter
Dim rowLetter As String   ' To hold the current row letter value
Dim firstRow As Long   ' First row of your data
Dim lastRow As Long   ' Last row of your data
Dim currentRow As Long   ' Current row for your loop counter
Dim sht As Worksheet   ' To hold the worksheet you're working on

2) Assign some values

2)分配一些值

Set sht = ThisWorkbook.Worksheets("*WORKSHEET NAME*")   ' Use the name of your worksheet
firstRow = 1
lastRow = sht.Range("A" & Rows.Count).End(xlUp).Row

3) Get your user input

3)获取用户输入。

indice = UCase(InputBox("Digite o IC/IV Desejado", "GBG Pneus"))   ' Convert user input to upper case and store

4) Do your processing

4)你的处理

For currentRow = lastRow To firstRow Step -1
    rowLetter = UCase(Right(sht.Range("H" & currentRow).Value, 1))   ' Get letter from code in column H, converted to upper case
    If rowLetter < indice Then   ' Compare the letters, and if smaller than user input...
        sht.Rows(currentRow).EntireRow.Delete   ' Delete the row
    End If
Next currentRow

And that should about do it. It's a good idea to declare all variables you plan to use, and using Option Explicit will ensure you can't use anything without declaring it first.

我们应该这么做。声明计划使用的所有变量是一个好主意,使用选项显式将确保在没有声明之前不能使用任何东西。

EDIT:

编辑:

@LeonVFX: If the value of the letters doesn't always increase with alphabetical order then you could use a lookup table or you could do the comparison in code.

@LeonVFX:如果字母的值不总是按照字母顺序增加,那么你可以使用查找表,或者你可以在代码中进行比较。

If you choose to use a lookup table like in your original example, then you could adjust the code above as follows:

如果您选择像原来的示例那样使用查找表,那么您可以调整上面的代码如下所示:

Dim indice As String   ' To hold our user input letter
Dim indiceValue As Long   ' To hold the numeric value of our user input letter
Dim rowLetter As String   ' To hold the current row letter
Dim rowLetterValue As Long   ' To hold the numeric value of the current row letter
Dim firstRow As Long   ' First row of your data
Dim lastRow As Long   ' Last row of your data
Dim currentRow As Long   ' Current row for your loop counter
Dim sht As Worksheet   ' To hold the worksheet you're working on
Dim planilhaV As Worksheet   ' To hold your lookup worksheet

Set sht = ThisWorkbook.Worksheets("*WORKSHEET NAME*")   ' Use the name of your worksheet
Set planilhaV = ThisWorkbook.Worksheets("IV")   ' As in your original example
firstRow = 1
lastRow = sht.Range("A" & Rows.Count).End(xlUp).Row

indice = UCase(InputBox("Digite o IC/IV Desejado", "GBG Pneus"))   ' Convert user input to upper case and store
indiceValue = CLng(Application.VLookup(indice, planilhaV.Range("A2:B11"), 2, False))   ' Creating numeric indice value with lookup table

For currentRow = lastRow To firstRow Step -1
    rowLetter = UCase(Right(sht.Range("H" & currentRow).Value, 1))   ' Get letter from code in column H, converted to upper case
    rowLetterValue = CLng(Application.VLookup(rowLetter, planilhaV.Range("A2:B11"), 2, False))   ' Creating numeric value for current row letter with lookup table
    If rowLetterValue < indiceValue Then   ' Compare the numeric letter values, and if smaller than user input...
        sht.Rows(currentRow).EntireRow.Delete   ' Delete the row
    End If
Next currentRow

If you're finding that it's only deleting one row at a time, my guess is that using sht.Range("A" & Rows.Count).End(xlUp).Row to find the last row is the reason because you don't have any data in column A? If your data is in column H as in your original example, change the A to an H in the code and you should be fine, or try and find a more reliable way to set your lastRow variable value.

如果您发现每次只删除一行,我的猜测是使用sht。范围(“A”& Rows.Count)指标(xlUp)。最终找到最后一行是因为A列中没有任何数据?如果您的数据在H列,如原始示例中所示,那么在代码中将A改为H,您应该没问题,或者尝试找到一种更可靠的方法来设置lastRow变量值。

#2


0  

After I got some help in a forum, I got to this answer, and I'll leave it here if anyone run into something like this.

在论坛上得到一些帮助后,我得到了这个答案,如果有人遇到这样的问题,我就把它留在这里。

' Verifies if the digit is a number. If it is, returns True, False if it isn't.
Function ehNumero(ByVal digito As String) As Boolean

    a = Asc(digito)
    If a >= 48 And a <= 57 Then
        ehNumero = True
    Else
        enNumero = False
    End If

End Function

' Separates the code in a numeric and a alphabetic part.
Function separaCodigo(ByVal codigo As String, ByRef numero As Integer, ByRef letras As String) As Boolean
    p = 0
    For i = 1 To Len(codigo)
        digito = Mid(codigo, i, 1)
        If Not ehNumero(digito) Then ' Found the point break when it finds the first non-numeric digit.
            p = i
            Exit For
        End If
    Next i

    If p = 0 Or p = 1 Then
        numero = 0
        letras = ""
        separaCodigo = False
    Else
        codigo = UCase(codigo)
        numero = Int(Mid(codigo, 1, p - 1))
        letras = Mid(codigo, p)
        separaCodigo = True
    End If
End Function

' Gets the values from the configuration table.
Function valorDasLetras(ByVal letras As String) As Integer
    On Error GoTo trataErro

    valorDasLetras = Application.VLookup(letras, Worksheets("Configuração").Range("A2:B11"), 2, False)

    Exit Function

trataErro:
    valorDasLetras = 0 '

End Function

'Deletes the lines in the table in the interval.
Function deletar(ByVal numero As Integer, letras As String) As Integer

    valor = valorDasLetras(letras)
    If valor = 0 Then
        deletar = -1
        Exit Function
    End If

    limInf = numero
    limSup = valor

    Dim dados As Worksheet
    Set dados = ActiveWorkbook.ActiveSheet

    Dim linhasPraDeletar As Range
    totalLinhas = 0

    linha = 1
    Do While True

        curCodigo = dados.Cells(linha, 7) ' Using Column G

        If curCodigo = "" Then
            Exit Do
        End If

        Dim curNumero As Integer
        Dim curLetras As String
        If Not separaCodigo(curCodigo, curNumero, curLetras) Then
            deletar = -1
            Exit Function
        End If

        ' Gets the values for the letters from the table
        curValor = valorDasLetras(curLetras)
        If curValor = 0 Then
            deletar = -1
            Exit Function
        End If

        If curNumero < limInf Or curValor < limSup Then
            If linhasPraDeletar Is Nothing Then
                Set linhasPraDeletar = dados.Rows(linha)
            Else
                Set linhasPraDeletar = Union(linhasPraDeletar, dados.Rows(linha))
            End If
            totalLinhas = totalLinhas + 1
        End If

        linha = linha + 1
    Loop

    linhasPraDeletar.Select
    linhasPraDeletar.EntireRow.Delete ' <===== Comment to select, but do not delete, the line

    deletar = totalLinhas

End Function

' Run the code
Sub LimparValores()
    'On Error GoTo trataErro

    ' Reads the user code
    msg = "Input your code"
    codigo = InputBox(msg, "Código")
    If codigo = "" Then ' Cancelado
        Exit Sub
    End If

    ' Separates the user code number from letters
    Dim numero As Integer
    Dim letras As String
    If Not separaCodigo(codigo, numero, letras) Then
        MsgBox ("Invalid code: " & codigo)
        Exit Sub
    End If

    ' Calls the delete function
    linhas = deletar(numero, letras)
    If linhas = -1 Then
        MsgBox ("There was an error with the code (the letter does not exist in configuration)")
    Else
        If linhas = 0 Then
            MsgBox ("There are no rows in the interval - no row was deleted")
        Else
            MsgBox (linhas & " rows deleted!")
        End If
    End If

    Exit Sub

trataErro:
    MsgBox ("The code is not in the expected format.")

End Sub

Hope it helps anyone in the future!

希望它能帮助未来的任何人!

#1


1  

Assuming that your order of priority for the letters is always alphabetical, you don't need to convert letters to numbers for this, you can simply compare letter to letter. I would also note that your way to determine the last row (Range("A" & Rows.Count).End(xlUp).Row) is not good practice, I suggest you find a more reliable method.

假设字母的优先顺序总是按字母顺序排列,你不需要把字母转换成数字,你可以简单地把字母和字母进行比较。我还要注意,您确定最后一行(Range(“A”& row . count). end (xlUp). row)的方法并不是很好的实践,我建议您找到一个更可靠的方法。

Assuming your data is presented as you have shown - with data in column H as a 3-character code where the letter is the last character (e.g. "91B", "89D", etc.) - lets go through step by step: (note there is no lookup worksheet planilhaV any more)

假设您的数据显示为您所显示的——在H列中显示的数据为3字符代码,其中字母是最后一个字符(例如:“91B”、“89D”等)——让我们一步一步地进行:(注意,不再有查找工作表planilhaV)

1) Declare our variables

1)声明变量

Dim indice As String   ' To hold our user input letter
Dim rowLetter As String   ' To hold the current row letter value
Dim firstRow As Long   ' First row of your data
Dim lastRow As Long   ' Last row of your data
Dim currentRow As Long   ' Current row for your loop counter
Dim sht As Worksheet   ' To hold the worksheet you're working on

2) Assign some values

2)分配一些值

Set sht = ThisWorkbook.Worksheets("*WORKSHEET NAME*")   ' Use the name of your worksheet
firstRow = 1
lastRow = sht.Range("A" & Rows.Count).End(xlUp).Row

3) Get your user input

3)获取用户输入。

indice = UCase(InputBox("Digite o IC/IV Desejado", "GBG Pneus"))   ' Convert user input to upper case and store

4) Do your processing

4)你的处理

For currentRow = lastRow To firstRow Step -1
    rowLetter = UCase(Right(sht.Range("H" & currentRow).Value, 1))   ' Get letter from code in column H, converted to upper case
    If rowLetter < indice Then   ' Compare the letters, and if smaller than user input...
        sht.Rows(currentRow).EntireRow.Delete   ' Delete the row
    End If
Next currentRow

And that should about do it. It's a good idea to declare all variables you plan to use, and using Option Explicit will ensure you can't use anything without declaring it first.

我们应该这么做。声明计划使用的所有变量是一个好主意,使用选项显式将确保在没有声明之前不能使用任何东西。

EDIT:

编辑:

@LeonVFX: If the value of the letters doesn't always increase with alphabetical order then you could use a lookup table or you could do the comparison in code.

@LeonVFX:如果字母的值不总是按照字母顺序增加,那么你可以使用查找表,或者你可以在代码中进行比较。

If you choose to use a lookup table like in your original example, then you could adjust the code above as follows:

如果您选择像原来的示例那样使用查找表,那么您可以调整上面的代码如下所示:

Dim indice As String   ' To hold our user input letter
Dim indiceValue As Long   ' To hold the numeric value of our user input letter
Dim rowLetter As String   ' To hold the current row letter
Dim rowLetterValue As Long   ' To hold the numeric value of the current row letter
Dim firstRow As Long   ' First row of your data
Dim lastRow As Long   ' Last row of your data
Dim currentRow As Long   ' Current row for your loop counter
Dim sht As Worksheet   ' To hold the worksheet you're working on
Dim planilhaV As Worksheet   ' To hold your lookup worksheet

Set sht = ThisWorkbook.Worksheets("*WORKSHEET NAME*")   ' Use the name of your worksheet
Set planilhaV = ThisWorkbook.Worksheets("IV")   ' As in your original example
firstRow = 1
lastRow = sht.Range("A" & Rows.Count).End(xlUp).Row

indice = UCase(InputBox("Digite o IC/IV Desejado", "GBG Pneus"))   ' Convert user input to upper case and store
indiceValue = CLng(Application.VLookup(indice, planilhaV.Range("A2:B11"), 2, False))   ' Creating numeric indice value with lookup table

For currentRow = lastRow To firstRow Step -1
    rowLetter = UCase(Right(sht.Range("H" & currentRow).Value, 1))   ' Get letter from code in column H, converted to upper case
    rowLetterValue = CLng(Application.VLookup(rowLetter, planilhaV.Range("A2:B11"), 2, False))   ' Creating numeric value for current row letter with lookup table
    If rowLetterValue < indiceValue Then   ' Compare the numeric letter values, and if smaller than user input...
        sht.Rows(currentRow).EntireRow.Delete   ' Delete the row
    End If
Next currentRow

If you're finding that it's only deleting one row at a time, my guess is that using sht.Range("A" & Rows.Count).End(xlUp).Row to find the last row is the reason because you don't have any data in column A? If your data is in column H as in your original example, change the A to an H in the code and you should be fine, or try and find a more reliable way to set your lastRow variable value.

如果您发现每次只删除一行,我的猜测是使用sht。范围(“A”& Rows.Count)指标(xlUp)。最终找到最后一行是因为A列中没有任何数据?如果您的数据在H列,如原始示例中所示,那么在代码中将A改为H,您应该没问题,或者尝试找到一种更可靠的方法来设置lastRow变量值。

#2


0  

After I got some help in a forum, I got to this answer, and I'll leave it here if anyone run into something like this.

在论坛上得到一些帮助后,我得到了这个答案,如果有人遇到这样的问题,我就把它留在这里。

' Verifies if the digit is a number. If it is, returns True, False if it isn't.
Function ehNumero(ByVal digito As String) As Boolean

    a = Asc(digito)
    If a >= 48 And a <= 57 Then
        ehNumero = True
    Else
        enNumero = False
    End If

End Function

' Separates the code in a numeric and a alphabetic part.
Function separaCodigo(ByVal codigo As String, ByRef numero As Integer, ByRef letras As String) As Boolean
    p = 0
    For i = 1 To Len(codigo)
        digito = Mid(codigo, i, 1)
        If Not ehNumero(digito) Then ' Found the point break when it finds the first non-numeric digit.
            p = i
            Exit For
        End If
    Next i

    If p = 0 Or p = 1 Then
        numero = 0
        letras = ""
        separaCodigo = False
    Else
        codigo = UCase(codigo)
        numero = Int(Mid(codigo, 1, p - 1))
        letras = Mid(codigo, p)
        separaCodigo = True
    End If
End Function

' Gets the values from the configuration table.
Function valorDasLetras(ByVal letras As String) As Integer
    On Error GoTo trataErro

    valorDasLetras = Application.VLookup(letras, Worksheets("Configuração").Range("A2:B11"), 2, False)

    Exit Function

trataErro:
    valorDasLetras = 0 '

End Function

'Deletes the lines in the table in the interval.
Function deletar(ByVal numero As Integer, letras As String) As Integer

    valor = valorDasLetras(letras)
    If valor = 0 Then
        deletar = -1
        Exit Function
    End If

    limInf = numero
    limSup = valor

    Dim dados As Worksheet
    Set dados = ActiveWorkbook.ActiveSheet

    Dim linhasPraDeletar As Range
    totalLinhas = 0

    linha = 1
    Do While True

        curCodigo = dados.Cells(linha, 7) ' Using Column G

        If curCodigo = "" Then
            Exit Do
        End If

        Dim curNumero As Integer
        Dim curLetras As String
        If Not separaCodigo(curCodigo, curNumero, curLetras) Then
            deletar = -1
            Exit Function
        End If

        ' Gets the values for the letters from the table
        curValor = valorDasLetras(curLetras)
        If curValor = 0 Then
            deletar = -1
            Exit Function
        End If

        If curNumero < limInf Or curValor < limSup Then
            If linhasPraDeletar Is Nothing Then
                Set linhasPraDeletar = dados.Rows(linha)
            Else
                Set linhasPraDeletar = Union(linhasPraDeletar, dados.Rows(linha))
            End If
            totalLinhas = totalLinhas + 1
        End If

        linha = linha + 1
    Loop

    linhasPraDeletar.Select
    linhasPraDeletar.EntireRow.Delete ' <===== Comment to select, but do not delete, the line

    deletar = totalLinhas

End Function

' Run the code
Sub LimparValores()
    'On Error GoTo trataErro

    ' Reads the user code
    msg = "Input your code"
    codigo = InputBox(msg, "Código")
    If codigo = "" Then ' Cancelado
        Exit Sub
    End If

    ' Separates the user code number from letters
    Dim numero As Integer
    Dim letras As String
    If Not separaCodigo(codigo, numero, letras) Then
        MsgBox ("Invalid code: " & codigo)
        Exit Sub
    End If

    ' Calls the delete function
    linhas = deletar(numero, letras)
    If linhas = -1 Then
        MsgBox ("There was an error with the code (the letter does not exist in configuration)")
    Else
        If linhas = 0 Then
            MsgBox ("There are no rows in the interval - no row was deleted")
        Else
            MsgBox (linhas & " rows deleted!")
        End If
    End If

    Exit Sub

trataErro:
    MsgBox ("The code is not in the expected format.")

End Sub

Hope it helps anyone in the future!

希望它能帮助未来的任何人!