将值粘贴到dynamic范围excel vba中
我正在编写一个脚本，用于在数据库中启用search，将search查询的结果显示在另一个工作表（我将其命名为Results）中，以便用户无法同时访问整个数据库。
为了做到这一点，我想将“数据库”工作表中的值复制到“结果”工作表中。 就任何特定的search标准而言，我已经成功地从“数据库”中select了正确的数据。 我用下面的代码做了这个：
With Sheets("Database") .Range(.Cells(i, 1), .Cells(i, 9)).Copy End With 现在我要将结果粘贴到“结果”电子表格中，并通过编写以下内容来完成：
Sheets("Results").Range("B600").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
通过这样做，我不太明白：
-
如果我已经严格定义了第一个空行和B600之间的粘贴范围，
-
如果我只是定义了粘贴范围的开始，并且在search结果超过第600行的情况下，它们仍然粘贴在此行之后。
我这样问，因为随着数据库的增长，我肯定需要保证一个比B600更大的粘贴范围。
我已经研究过，但似乎无法完全确定我所做的事情。 我必须说，我知道“结果”数据库中的第一个空行将始终是12.在这种情况下，我知道我基本上想粘贴从第12行的search结果。 也许有一个更直接的方法来做到这一点。
这是整个代码，供参考：
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
非常感谢您的帮助。
- 两个ListObjects
tblDatabase和tblResults -
tblResults数据被清除 - filter应用于
tblDatabase的第二，第三和第四列 - 如果结果less于588个，我们将从
tblDatabase过滤的logging复制到tblResults - 如果有超过588个结果，则我们将筛选logging的范围调整到最初的588个logging，然后将它们复制到
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
您可以从工作表底部到列B中最后一个使用的单元计数，然后按1行OFFSET 。 这可以防止你需要担心
a）粘贴的范围从第12行开始（它们应该包含值），以及
b）您目前正在使用B600的硬编码“锚点”，随着数据的增长，这将需要更新。
示例代码：
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
Dim searchdata as range，inputfromuser as string
inputfromuser = inputbox（“input你想要search的内容”）
设置searchdata = sheets（“Database”）。find（inputfromuser）.select
searchdata = activecell.value或activecell.offset（10,5）.value
片材（“结果”）。激活
与表（“结果”）
范围（ “A12”，范围（ “A12”）。端部（xldown））。偏移（1,0）。select
searchdata.copy destination：= activecell
activecell.offset（1,0）。select
结束
不知道，如果我理解你corectly队友。
我没有Excel表单或VBE编辑器。 只是直接写在网站上。 请根据您的需要修改。