Question

到目前为止我的代码：

Sub Leads()

ActiveSheet.Range("J:J").Select

For i = 1 To 100

ActiveCell.Offset(1, 0).Select

If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1")

Next i

End Sub

我想向下滚动J列，每当“另一辆车”和“Mikes Auto Shop”的一部分出现时，我想将其右下方的行复制并粘贴到“L，M和O”中同一行内的列。

就像这个http://imgur.com/a/Bt3A5一样，但会循环数百行代码

非常感谢大家的帮助，谢谢！

Answer 1

这将有一些假设，例如，Mikes Auto Shop中没有撇号，并且汽车模型中的第一个空间是分割数据的正确位置。

Option Compare Text
Sub test()

Dim DataRange As Range
Dim LastRow As Integer
Dim i As Integer
Dim SplitVal() As String

LastRow = Cells(Rows.Count, "J").End(xlUp).Row

For i = 1 To LastRow
  If ActiveSheet.Cells(i, 10).Value = "Another Car" Then
    If InStr(1, Cells(i + 3, 10).Value, "Mikes Auto Shop", vbTextCompare) <> 0 Then
      SplitVal = Split(Cells(i + 1, 10).Value, " ", 2)
      Cells(i + 1, 12).Value = SplitVal(0)
      Cells(i + 1, 13).Value = SplitVal(1)
      Cells(i + 1, 15).Value = Cells(i + 4, 10).Value
    End If
  End If
Next i


End Sub

根据评论请求进行修改。我不确定你想要输出的位置，你可以调整OutputOffset，Mikes Auto Shop行是0，-1是up，+ 1是down。

Sub test()

Dim DataRange As Range
Dim LastRow As Integer
Dim i As Integer
Dim SplitVal() As String
Dim OutputOffset As Long
OutputOffset = 0

LastRow = Cells(Rows.Count, "J").End(xlUp).Row

For i = 2 To LastRow
    If InStr(1, Cells(i, 10).Value, "Mikes Auto Shop", vbTextCompare) <> 0 Then
      SplitVal = Split(Cells(i - 1, 10).Value, " ", 2)
      Cells(i + OutputOffset, 12).Value = SplitVal(0)
      Cells(i + OutputOffset, 13).Value = SplitVal(1)
      Cells(i + OutputOffset, 15).Value = Cells(i + 1, 10).Value
    End If
Next i


End Sub

Answer 2

让我们从您的代码开始：

Sub Leads()

    ActiveSheet.Range("J:J").Select

    For i = 1 To 100

        ActiveCell.Offset(1, 0).Select

        If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1")

    Next i

End Sub

我会做什么：

摆脱ActiveSheet.Range("J:J").Select，因为选择

注意：For i = 1 To 100将从1到100的行。您可能希望实际使用动态方法来检查该数字。您可以查看以下内容：https://stackoverflow.com/a/11169920/2012740。

如果您删除了所选内容，请同时删除ActiveCell.Offset(1, 0).Select

If ActiveCell.Value = "Another Car" Then Range("J1").Copy ("L1")将成为：

If Cells(i,10).Value = "Another Car" Then 'This condition is the same as before

  SplitedValue = Split(Cells(i+1,10).Value," ") ' With this code you will split the value from the first row below the row which contains "Another Car" text. The value is splitted by " " (empty space). For more references and parameters you can read about the other parameters of `split` function

  Cells(i+1,12).Value = SplitedValue(0) 'This will add the first part of the splitted string in the cell which is one row below the current row, and on column 12 (L)

  Cells(i+1,13).Value = SplitedValue(1) 'This will add the second part of the splitted string in the cell which is one row below the current row, and on column 13 (M)

  Cells(i+1,15).Value = Cells(i+4,10).Value ' This will add the value from the cell which is located 4 rows below the current cell, to the cell which is located one row below the current row and on column 15 (O)

EndIf 'Close the if statement here

请记住声明dim SplitedValue as Variant

VBA，我的所有数据都在一个列中。如何扫描并获取所有相关信息？

2 个答案: