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

不能似乎弄清楚为什么我的代码不显示输出。 新的VBA程序员只知道基本知识,所以任何帮助将是有帮助的。

我想要的是让Excel开始检查特定文本的特定列1,然后开始复制并粘贴这些值直到达到text2。 之后,我希望它以相同的方式检查下一个第五列。 如果你可以build议修改我的代码。 没有在列的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 

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

唯一可能导致结果的其他事情是当你有不同的case ,因为VBA会把一个大写字符的string视为不同的字符,所以你可能根本没有进入循环。 我假设text1只是一个示例string的问题。

因此,比较小写string将确保如果您有任何大写字符,他们将被正确比较,使用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 

很难看到大局,但我想我产生了你想要的结果:

 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 

这个代码是不完美的,但应该在大多数情况下工作。