使用動態陣列存盤和粘貼值

首先抱歉我的英語不好，這不是我的母語。我有一個動態表，當我插入一個特定的鍵號時它會改變它的內容

在這種情況下，keynumber 是“5”，并且該表的所有內容都根據我輸入的數字（從 1 到 42）而變化。

我想要做的是復制所有資料并僅粘貼同一作業表上空行中的值。我用下一個代碼實作了這一點：

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 按鈕時，它會復制并粘貼到作業表的右側。

但是現在我需要做同樣的事情，但是對于整個鍵號，例如，我需要對 1 到 42 的所有表的值進行復制和粘貼，而不僅僅是一個一個。

我不知道如何輸入例如 keynumber 1 計算作業表然后復制內容并將值粘貼到右側，然后再次執行但對于 keynumber 2 依此類推，直到它以 keynumber 42 結束...

有什么方法可以實作嗎？我不太熟悉 vba，但我想我需要做一個動態陣列或類似的東西

提前致謝

uj5u.com熱心網友回復：

我認為沒有陣列會更容易：

  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

uj5u.com熱心網友回復：

按分配復制值

• 當您這樣做時drg.Value = srg.Value，它的速度與您復制值（不是公式或格式）的速度一樣快。它被稱為通過賦值復制，有一個簡單的規則：兩個范圍必須具有相同的大小（相同的行數和列數）。通常，您只知道目標范圍的第一個單元格，并且您知道它必須具有源范圍的大小。讓我們呼叫第一個單元格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

標籤：

上一篇：（已解決）無法從Flutter中的守護行程接收訊息

下一篇：在Windows上錄制后在macOS上播放AntMediaServerVOD的問題