使用动态数组存储和粘贴值

Question

首先抱歉我的英语不好，这不是我的母语。我有一个动态的 table，当我插入一个特定的键号时它会改变它的内容

本例中的键号是“5”，sheet的所有内容根据我输入的数字（从 1 到 42）而变化。

我想做的是复制所有数据并仅将值粘贴到同一 sheet 的空行中。我用下一个代码实现了这一点：

Sheets("Biblia General").Range("B8:H142").Copy
Sheets("Biblia General").Range("M8").PasteSpecial xlPasteValues
'Remove the animation around the copied cell
Application.CutCopyMode = False
Selection.Sort key1:=Range("N8")

当我按下 copiar 按钮时，它会复制然后粘贴到 sheet 的右侧。

但现在我需要做同样的事情，但对于整个键号，例如我需要运行复制并粘贴 1 到 42 的所有 table 的值不只是一一的。

我不知道如何输入例如密钥编号 1 计算 sheet 然后复制内容并将值粘贴到右侧，然后再次执行但对于密钥编号 2 等等，直到它结束于键号 42...

有什么办法可以实现吗？我不太熟悉 vba 但我想我需要做一个动态数组或类似的东西

提前致谢

Answer 1

我觉得不用数组更简单:

  Dim i As Long
  
  For i = 1 To 42
    [D1].Value = i    'set the key number (please check the address
    Sheets("Biblia General").Range("B8:H142").Copy '135 rows
    'Paste each block below the previous one
    Sheets("Biblia General").Range("M8").Offset((i - 1) * 135, 0).PasteSpecial xlPasteValues
    'Remove the animation around the copied cell
    Application.CutCopyMode = False
    Selection.Sort key1:=Range("N8")
  Next i

Answer 2

按赋值复制值

当您执行 drg.Value = srg.Value 时，它会尽可能快地复制值（不是公式或格式）。它被称为 Copying by Assignment 并且有一个简单的规则：两个范围必须具有相同的大小（相同的行数和列数）。通常，您只知道目标区域的第一个单元格，并且您知道它必须具有源区域的大小。我们称第一个单元格为 dfCell。要创建对目标范围的引用，您将执行以下操作：
```
Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count, srg.Columns.Count)
```

代码

Option Explicit

Sub CopyData()
    
    Const wsName As String = "Biblia General"
    Const ClaveCount As Long = 42
    Const ClaveAddress As String = "C1" ' Clave
    Const LoteAddress As String = "C3" ' Lote
    Const srgAddress As String = "B8:H142"
    Const dfCellAddress As String = "M8"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim srg As Range: Set srg = ws.Range(srgAddress)
    Dim Clave As Range: Set Clave = ws.Range(ClaveAddress)
    Dim Lote As Range: Set Lote = ws.Range(LoteAddress)
    
    Dim rCount As Long: rCount = srg.Rows.Count
    Dim cCount As Long: cCount = srg.Columns.Count
    
    Dim dfCell As Range: Set dfCell = ws.Range(dfCellAddress)
    
    Application.ScreenUpdating = False
    
    dfCell.Offset(, -1).Resize(ws.Rows.Count - dfCell.Row + 1, cCount + 1) _
        .ClearContents
    
    Dim drg As Range
    Dim dclrrg As Range
    Dim n As Long
    
    For n = 1 To ClaveCount
        Clave.Value = n
        Set drg = dfCell.Resize(rCount, cCount)
        drg.Value = srg.Value
        If n = 1 Then
            drg.Cells(1).Offset(, -1).Value = "Lote" ' Lote
            ' exclude headers
            rCount = rCount - 1
            Set srg = srg.Resize(rCount).Offset(1)
            Set drg = drg.Resize(rCount).Offset(1)
        End If
        drg.Columns(1).Offset(, -1).Value = Lote.Value ' Lote
        drg.Sort drg.Columns(2), xlAscending, , , , , , xlNo
        Set dfCell = drg.Columns(2) _
            .Find("*", , xlValues, , , xlPrevious).Offset(1, -1)
        Set dclrrg = drg.Resize(drg.Row + rCount - dfCell.Row) _
            .Offset(dfCell.Row - drg.Row, -1).Resize(, cCount + 1)
        dclrrg.ClearContents
    Next n

    Application.ScreenUpdating = True
    
    MsgBox "Data copied.", vbInformation, "CopyData"

End Sub

使用动态数组存储和粘贴值

Store and Paste values with a dynamic array

macos

excel

vba

ms-office

按赋值复制值