循环遍历范围，一旦find值，将单元格值和所有内容复制到下一列
这是我的第一篇文章。 我一直在教自己擅长的VBA，这是相当具有挑战性的。
反正我一直在循环和范围等工作
这是我的困境：
Option Explicit Sub Move_Data() Dim i As Long Dim j As Long Dim LastRow As Long Dim LastColumn As Long Dim rng As Range Dim result As String result = "New Results" LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column For i = 3 To LastRow For j = 1 To LastColumn If Cells(i, 1) = result Then j = j + 1 Cells(i, 1).Copy Destination:=ActiveSheet.Cells(i, j) End If Next j Next i End Sub 我一点一点把上面的内容放在一起。 这是我的问题：
我正在尝试查看列“A”中的所有值。 一旦发现“新结果”，我想不仅复制这个单元格，而且复制下面的所有单元格到列“J”。 然后find列“B”中的string，并将范围复制到列“K”等。
到目前为止，代码find“新结果”，并将其移动到列“B”，这是预期的，因为这是我写的唯一的代码。 如何添加另一个循环，将“新结果”下的所有内容一起复制并移动到新列中。 这样J会不断增加，最终我会把所有的结果按列分解。
希望这是有道理的。
谢谢大家，
你不必循环所有的单元格。 而是使用Find() method 。 我觉得效率更高。
Sub Move_Data() Dim rngFound As Range Dim intColLoop As Integer Dim LastColumn As Integer Dim result As String 'added in edit, forgot that, oops Dim intColPaste As Integer 'added in edit result = "New Results" LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column With Cells 'in case the result is not on the ActiveSheet, exit code If .Find(result) Is Nothing Then Exit Sub '*****************Search all the columns, find result, copy ranges 'search all the columns For intColLoop = 1 To LastColumn With Columns(intColLoop) 'check if the result is in this column If Not .Find(result) Is Nothing Then 'find the result Set rngFound = .Find(result) 'copy the found cell and continuous range beneath it to the destination column Range(rngFound, rngFound.End(xlDown)).Copy Destination:=Cells(Rows.Count, 10 + intColPaste).End(xlUp) 'Edit : changed the "10" to "10 + intColPaste" intColPaste = intColPaste + 1 'Edit : added counter for columns End If End With Next intColLoop 'proceed to next column End With End Sub
祝贺你的第一篇文章写得很好！
Option Explicit Sub Move_Data() Dim SourceCol As integer Dim DestCol As Integer Dim LastRow As Long 'Dim LastColumn As Long Dim rng As Range Dim result As String Dim Addr as string SourceCol = 1 'Column A DestCol = 2 'Column B result = "New Results" LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row set rng = ActiveSheet.Range(cells.Address).Find (What:=Result, LookIn:=xlValues, _ LookAt:=xlWhole, MatchCase:=False) While not rng is Nothing and Addr <> rng.Range.Address 'If not rng is Nothing ActiveSheet.range(cells(rng.row, DestCol),cells(LastRow,DestCol) = _ ActiveSheet.range(cells(rng.row,SourceCol), cells(LastRow,SourceCol)) 'End If Addr = rng.range.address(ReferenceStyle:=xlR1C1) set rng = ActiveSheet.Range(cells.Address).Find (What:=Result, LookIn:=xlValues, _ LookAt:=xlWhole, MatchCase:=False) wend End Sub
根据需要调整SourceCol和DestCol 。
这是没有经过检验的，也是我的头顶，所以可能需要稍微调整一下。 使用.Find()查找您的文本，然后将您的目标范围设置为您刚发现的内容。
正如所写，它会发现一个result事件。 如果result有多个出现，则注释掉/删除If...和'End If`这两行，然后取消注释到的四行注释，并循环查找。