时间戳

首页 > 解决方案 > 获取搜索结果后如何粘贴到不同的行

excel - 获取搜索结果后如何粘贴到不同的行

问题描述

在搜索整个 A 列中的单词“Country Code:”后，我需要有关如何将结果粘贴到列“G”行“2”的帮助。以下是我的流程代码。

目前我的代码能够复制特定的单词并粘贴它。但它只粘贴在与现有数据重叠的 A 列上。

 Sub SearchForString()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer
   Dim LCopytoColumn As String


   'On Error GoTo Err_Execute

   'Start search in row 1
    LSearchRow = 1

   'Start copying data to column G in Database
    LCopytoColumn = 7

   'Start copying data to row 2 in Database and Loop results
    LCopyToRow = 2


   While Len(Range("A" & CStr(LSearchRow)).Value) > 0

          'If value in column E = "Mail Box", copy entire row to Sheet2
           If InStr(1, Range("A" & CStr(LSearchRow)).Value, "Country Code:") > 0 Then

         'Select row in Sheet1 to copy
          Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
          Selection.Copy

          'Paste row into G2 in next row
           Range("G2").Select
          'Columns(CStr(LCopytoColumn) & ":" & CStr(LCopytoColumn)).Select
           Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
           ActiveSheet.Paste


           'Move counter to next row
            LCopyToRow = LCopyToRow + 1

           'Go back to Database to continue searching
           Sheets("Database").Select

        End If

        LSearchRow = LSearchRow + 1

   Wend

   'Position on cell G2
    Application.CutCopyMode = False
    Range("G2").Select

    MsgBox "All matching data has been copied."

   Exit Sub

'Err_Execute:
'   MsgBox "An error occurred."

 End Sub

标签： excelvba

解决方案

使用变体数组既简单又快速。

Sub test()
    Dim Ws As Worksheet
    Dim toWs As Worksheet
    Dim vDB, vR()
    Dim i As Long, n As Long, c As Integer
    Dim j As Integer

    Set Ws = Sheets("yoursheetname")
    Set toWs = Sheets("Database")

    vDB = Ws.UsedRange
    c = UBound(vDB, 2)
    For i = 1 To UBound(vDB, 1)
        If InStr(vDB(i, 1), "Country Code:") Then
            n = n + 1
            ReDim Preserve vR(1 To c, 1 To n)
            For j = 1 To c
                vR(j, n) = vDB(i, j)
            Next j
        End If
    Next i
    toWs.Range("g2").Resize(n, c) = WorksheetFunction.Transpose(vR)
End Sub

推荐阅读