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

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

这是我的代码循环遍历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＆＃39; Eh＆＃39;培根指出，你需要提供一些方法来处理字符串值。

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

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

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

如果要检查单元格是否为空白，可以检查单元格的长度。 E.g：

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

VBA Excel：如何在包含字母数字或数字内容的单元格中循环显示B列？

1 个答案: