Question

似乎无法弄清楚为什么我的代码没有显示输出。新的VBA程序员只知道基础知识，所以任何帮助都会有所帮助。

我想要的是Excel开始检查特定text1的特定列，然后开始复制并粘贴这些值，直到它到达text2。之后，我希望它以相同的方式检查下一个第五列。如果您可以建议修改我的代码。没有为列添加for循环，我的代码看起来像这样。

Private Sub CommandButton7_Click()
    Dim x As Long, y As Long
    Dim a As Long

    y = 1 'starts with the first column
    x = 1  'first row
    a = 70 'this is the row where i want the data to be posted

    If Cells(x, y).Value = "text1" Then 'check first for specific text
        Do Until Cells(x, y).Value = "text2" 'stop here
            Cells(a, y).Value = Cells(x, y).Value 'copy that data to new row
            Cells(a, y + 1).Value = Cells(x, y + 1).Value 'and the column adjacent to it
            x = x + 1
            a = a + 1
        Loop
    Else
        x = x + 1 'if not on that row then check the next row       
    End If
End Sub

Answer 1

真的很难看出这里出了什么问题，因为你的代码应该做你想做的事。

唯一可以抛出结果的是当你有不同的case时，因为VBA会将大写字符的字符串视为不同，所以你可能根本不会进入循环。我假设text1只是问题的示例字符串。

因此，比较小写字符串将确保如果你有任何大写字符，他们将被正确比较，使用LCase函数应该有帮助。

完整代码，

Private Sub CommandButton7_Click()

 Dim x As Long, y As Long
 Dim a As Long

   y = 1 'starts with the first column

    x = 1  'first row
    a = 70 'this is the row where i want the data to be posted
            If LCase(Cells(x, y).Value) = LCase("text1") Then 'check first for specific text
            Do Until LCase(Cells(x, y).Value) = LCase("text2") 'stop here
                Cells(a, y).Value = Cells(x, y).Value 'copy that data to new row
                Cells(a, y + 1).Value = Cells(x, y + 1).Value 'and the column adjacent to it
                x = x + 1
                a = a + 1
            Loop
            Else: x = x + 1 'if not on that row then check the next row

        End If
 End Sub

Answer 2

很难看到全局，但我认为我产生了你想要的结果：

Sub FindText()


Dim textFound As Range
Dim x As Long, y As Long
Dim a As Long
y = 1 'starts with the first column

x = 0  'first row
a = 70 'this is the row where i want the data to be posted

Set textFound = ActiveSheet.Columns(y).Cells.Find("Text1")

Do Until textFound.Offset(x, 0).Value = "Text2"

    Cells(a + x, y).Value = textFound.Offset(x, 0).Value
    Cells(a + x, y + 1).Value = textFound.Offset(x, 1).Value
    x = x + 1
Loop


End Sub

这段代码远非完美，但在大多数情况下都可以使用。

如果和DoUntil VBA代码不显示输出

2 个答案: