VBA Excel : How to loop through Column B for cells containing alphanumeric or just numeric content?

Question

我在 B 列中有需要循环遍历的数据，然后将 D 列中每一行的相应值复制到同一工作簿中的另一张工作表中。
我需要编写一个代码来搜索 B 列中的每个值，为同一行返回 D 列中的相应值，然后从给定范围中按顺序查找下一个数字(在这种情况下，我将其设置为 7 到 10 )。

因此，遍历 B 列，按该顺序查找值 7、7a、8、9、10(即使在向下时较大的值位于较低的值之前)，然后将 D 列中的相应值复制到另一张表。
Sheet3中的Excel数据图表(不需要A列):

A B C D E

1   1a  78.15   77.68      This is row 7
1a  2   77.18   76.92
2   3   76.92   76.63
3   4   76.13   75.78
4   4a  75.78   75.21
4a  5   75.11   74.87
5   5a  74.87   74.69
5a  6   73.94   73.6
6   6a  73.1    72.71
6a  6b  72.41   72.18
6b  10  72.18   71.6
10  11  71.3    70.89
11  12  70.89   69.83
12  13  69.83   68.68
13  14  68.68   67.68
14  15  67.63   66.46
15  16  66.01   64.84
16  16a 64.24   63.72
16a 16b 56.82   56.37
16b 16c 56.37   55.18
16c OUT 47.28   47.27
7   7a  83.12   76.07
7a  8   76.17   75.99
8   9   74.79   74.41
9   6   74.51   74        This is row 31

我的问题:当代码遇到包含字母和数字的单元格时，它会跳过该单元格并移动到该范围内仅包含​​数字的下一个单元格。如何编辑/重写代码以在搜索条件中包含字母数字值？

这是我的代码，它遍历 B 列，但不包括带有字母和数字的单元格:

Sub EditBEST()

Dim Startval As Long
Dim Endval As Long          'Finds values corresponding
                            'to input in B and C
Dim LastRow As Long



LastRow = Sheets("Sheet3").range("B" & Rows.Count).End(xlUp).Row
Startval = Worksheets("Sheet3").Cells(1, "O").Value
Endval = Worksheets("Sheet3").Cells(1, "P").Value


StartRow = 2                                            'row that first value will be pasted in



For x = 7 To LastRow                                         'decides range to search thru in "Sheet3"

   If Sheets("Sheet3").Cells(x, 2).Value >= 7 And Sheets("Sheet3").Cells(x, 2).Value <= 10 Then               'if cell is not blank
        Sheets("Sheet4").Cells(StartRow, 2).Value = _
                 Sheets("Sheet3").Cells(x, 4).Value             'copy/select cell value in D
         StartRow = StartRow + 1                                      'cell.Offset(0, 1).Value =
        End If
        If Sheets("Sheet3").Cells(x, 3) >= 7 And Sheets("Sheet3").Cells(x, 3).Offset(0, 1) <= 10 Then
            Sheets("Sheet4").Cells(StartRow, 2).Value = _
                Sheets("Sheet3").Cells(x, 5).Value
        StartRow = StartRow + 1
        End If

Next x


End Sub  

谢谢

Answer 1

您遇到的主要问题是您有条件检查过滤掉任何字符串值。正如@ Grade 'Eh' Bacon 指出的那样，您需要提供一些方法来处理字符串值。

您也有一些错误或误导性的评论。

例如，在这里，您添加了注释“如果单元格不是空白”，但这不是您实际检查的内容。

If Sheets("Sheet3").Cells(x, 2).Value >= 7 And Sheets("Sheet3").Cells(x, 2).Value <= 10 Then               'if cell is not blank

如果要检查单元格是否为空白，可以检查其长度。例如。:

If Len(Sheets("Sheet3").Cells(x, 2).Value) > 0 Then    

现在，对于这个过程来说，这真的不是完全必要的，但我只是想指出它，因为您的评论表明您正在尝试做一些与您的代码不同的事情。

我还没有测试过你的代码，但是我写了一个函数来为你从一个字符串中提取一个。这一切都未经测试，因此您可能需要对其进行调试，但应该对您的字符串问题进行排序。

Sub EditBEST()

    Dim Startval As Long
    Dim Endval As Long          'Finds values corresponding
                            'to input in B and C
    Dim StartOutputRow as Long
    Dim LastRow As Long

    Dim Val as Long
    Dim Val2 as Long

    LastRow = Sheets("Sheet3").range("B" & Rows.Count).End(xlUp).Row
    Startval = Worksheets("Sheet3").Cells(1, "O").Value
    Endval = Worksheets("Sheet3").Cells(1, "P").Value

    StartOutputRow =2      'first row we will output to
    OutputRow = StartOutputRow      'row of the cell to which matching values will be pasted

    For x = 7 To LastRow

       Val = GetSingleFromString(Sheets("Sheet3").Cells(x, 2).Value)

       If Val >= 7 And Val <= 10 Then               'if value is within range
           Sheets("Sheet4").Cells(OutputRow , 2).Value = _
                 Sheets("Sheet3").Cells(x, 4).Value             'copy cell  value from D @the current row to column B @the output row
           OutputRow = OutputRow + 1    'Next value will be on the next row                                  
       End If

       Val = GetSingleFromString(Sheets("Sheet3").Cells(x, 3).Value)
       Val2 = GetSingleFromString(Sheets("Sheet3").Cells(x, 3).Offset(0, 1).Value)

       If Val >= 7 And Val2 <= 10 Then
           Sheets("Sheet4").Cells(OutputRow , 2).Value = _
           Sheets("Sheet3").Cells(x, 5).Value             'copy cell  value from E @the current row to column B @the output row
           OutputRow = OutputRow + 1
       End If

    Next x

    'Sort the output:
    Sheets("Sheet4").Range("B:B").Sort key1:=Range(.Cells(StartOutputRow,2), order1:=xlAscending, header:=xlNo
End Sub 

Private Function GetSingleFromString(ByVal InString As String) As Single        

    If Len(InString) <= -1 Then
        GetSingleFromString = -1
        Exit Function
    End If

    Dim X As Long
    Dim Temp1 As String
    Dim Output As String

    For X = 1 To Len(InString)
        Temp1 = Mid(InString, X, 1)
        If IsNumeric(Temp1) Or Temp1 = "." Then Output = Output & Temp1
    Next

    If Len(Output) > 0 Then
        GetSingleFromString = CSng(Output)
    Else
        GetSingleFromString = -1
    End If

End Function