在动态范围 excel vba 中粘贴值

Question

我正在编写一个脚本，我想在其中启用数据库中的搜索，在不同的工作表（我将其命名为结果）中显示搜索查询的结果，以便用户无法访问整个同时数据库。

为此，我想将 "Database" 工作表中的值复制到 "Results" 工作表中。我已成功从 "Database" 中根据任何特定搜索条件选择了正确的数据。我使用以下代码完成此操作：

With Sheets("Database")
   .Range(.Cells(i, 1), .Cells(i, 9)).Copy
End With

现在我想将结果粘贴到 "Results" 电子表格中，我已通过编写以下内容完成此操作：

Sheets("Results").Range("B600").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

这样做，我不太明白：

如果我将粘贴范围严格定义为第一个空行和 B600 之间或；
如果我只是定义粘贴范围的开始，如果搜索结果超过第600行，它们仍然会粘贴到这一行之后。

我问这个是因为随着数据库的增长，我肯定需要保证大于B600的粘贴范围。

我已经对此进行了研究，但似乎不能完全确定我到底做了什么。我必须说我知道 "Results" 数据库中的第一个空行将始终为 12。在这种情况下，我知道我基本上想从第 12 行开始粘贴搜索结果。也许有更直接的方法来做到这一点。

这是全部代码，供参考：

Private Sub SearchButton_Click()

'This is the search function

'1. declare variables
'2. clear old search results
'3. Find records that match criteria and paste them

Dim country As String
Dim Category As String
Dim Subcategory As String
Dim finalrow As Integer
Dim i As Integer 'row counter


'Erase any entries from the Results sheet
Sheets("Results").Range("B10:J200000").ClearContents

'Deformat any tables in the Results sheet
For Each tbl In Sheets("Results").ListObjects
    tbl.Clear

    Next

'Define the user-inputed variables
country = Sheets("Results").Range("D5").Value
Category = Sheets("Results").Range("D6").Value
Subcategory = Sheets("Results").Range("D7").Value
finalrow = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row

'If statement for search

'For every variable i, start comparing from row 2 until the final row
For i = 2 To finalrow

    'If the country field is left empty
    If country = "" Then
        Sheets("Results").Range("B10:J200000").Clear
        MsgBox "You must select a country in order to search the database. Please do so in the drop-down list provided."
        Sheets("Results").Range("D5").ClearContents
        Sheets("Results").Range("D6").ClearContents
        Sheets("Results").Range("D7").ClearContents
        Exit Sub

    'If the country field is filled in and there results from the search made
    ElseIf Sheets("Database").Cells(i, 1) = country And _
        (Sheets("Database").Cells(i, 3) = Category Or Category = "") And _
        (Sheets("Database").Cells(i, 4) = Subcategory Or Subcategory = "") Then

            'Copy the headers of the table
            With Sheets("Database")
            .Range("A1:I1").Copy
            End With
            Sheets("Results").Range("B10:J10").PasteSpecial

            'Copy the rows of the table that match the search query
            With Sheets("Database")
            .Range(.Cells(i, 1), .Cells(i, 9)).Copy
            End With
            Sheets("Results").Range("B600").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

    'Hides search form
    Me.Hide

    End If

Next i

'Toggle Results sheet
Sheets("Results").Activate

'Format results as a table
Set rng = Range(Range("B10"), Range("B10").End(xlUp).SpecialCells(xlLastCell))
Set table = Sheets("Results").ListObjects.Add(xlSrcRange, rng, , xlYes)
table.TableStyle = "TableStyleMedium13"

Range("B11").Select

'Make Excel window visible
Application.Visible = True

End Sub

非常感谢您的帮助。

Answer 1

您可以从 sheet 的底部数到 B 列中最后使用的单元格，然后 OFFSET 1 行。这样您就无需担心

a) 要粘贴的范围从第 12 行开始（它们应该包含值），以及

b) 您当前使用的是 B600 的硬编码 'anchor'，随着数据的增长需要更新。

示例代码：

Dim ws As Worksheet
Dim rngColumnBUsed As Range
Dim lngFirstEmptyRow As Long

Set ws = ThisWorkbook.Sheets("Results")
Set rngColumnBUsed = ws.Range("B" & ws.Rows.Count).End(xlUp).Offset(1, 0)
lngFirstEmptyRow = rngColumnBUsed.Row

Answer 2

Dim searchdata as range, inputfromuser as string

inputfromuser = inputbox("type what you wanna search")

set searchdata = sheets("Database").find(inputfromuser).select

searchdata = activecell.value 或 activecell.offset(10,5).value

sheets("results").激活

和 sheets("result")

range("a12",range("a12").end(xldown)).offset(1,0).select

searchdata.copy 目的地：= activecell

activecell.offset(1,0).select

结束于

不确定，如果我理解你是正确的伴侣。

我没有excel sheet 或VBE 编辑器。只是直接在网站上写了这个。请根据您的需要进行修改。

Answer 3

两个 ListObjects tblDatabase 和 tblResults
tblResults 数据被清除
过滤器应用于 tblDatabase
如果少于 588 个结果，我们将过滤后的记录从 tblDatabase 复制到 tblResults
如果超过 588 个结果，我们将筛选记录的范围缩小到前 588 个记录，然后将它们复制到 tblResults
我们从不担心格式化，因为 tblResults 保持原始格式。

Sub ListObjectDemo()
    Dim tblDatabase As ListObject, tblResults As ListObject

    Set tblDatabase = Worksheets("Database").ListObjects("tblDatabase")
    Set tblResults = Worksheets("Results").ListObjects("tblResults")
    If Not tblResults.DataBodyRange Is Nothing Then tblResults.DataBodyRange.ClearContents

    With tblDatabase.Range
        .AutoFilter Field:=2, Criteria1:="Test A"
        .AutoFilter Field:=3, Criteria1:="East"
        .AutoFilter Field:=4, Criteria1:="Algeria"
    End With

    With tblDatabase.DataBodyRange
        If .Rows.Count <= 588 Then
            .Copy tblResults.ListRows.Add.Range
        Else
            .Resize(588).Copy tblResults.ListRows.Add.Range
        End If
    End With

End Sub

在动态范围 excel vba 中粘贴值

Paste values in dynamic range excel vba

excel

vba

copy-paste

range