Question

我有以下代码，它根据行数和列数将值从一个工作表复制并粘贴到另一个工作表。在逐个复制每个值时，代码非常有用。但是，我当前使用的数据集将始终具有第11到110行（总共100个值）中的值，只有列更改。

因此，如何使用箭头（＆lt; - ）更改代码行，以便始终复制第11行到第110行，仅偏移列号？

 Option Explicit

Sub Transpose_Lapse_LevelTrend()
Dim ws As Worksheet
Dim i, k, multiple As Integer
Dim rawrowcount As Long
Dim rawcolcount As Long
    'Define variables for the below-noted code

For i = 1 To ActiveWorkbook.Sheets.Count
    If ActiveWorkbook.Sheets(i).Name = "Q_Sheet7.1" Then
        ActiveWorkbook.Sheets(i).Delete
    End If
Next i
    'Delete Worksheet if already existing for respective tab

With ThisWorkbook
    Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    ws.Name = "Q_Sheet7.1"
    ws.Range("A1").Value = "Year"
    ws.Range("B1").Value = "Product"
    ws.Range("C1").Value = "Cashflow"
 End With

 With ThisWorkbook.Sheets("7.1")
.Range("A:A").Delete
rawrowcount = WorksheetFunction.CountA(.Range("A:A")) - WorksheetFunction.CountA(.Range("A1:A10")) - 1
rawcolcount = .Cells(10, Columns.Count).End(xlToLeft).Column - 2
 End With
     'Count the number of rows and columns to determine how many the number of iterations
'for the next set of code

Application.ScreenUpdating = False
    'Do not update screen while executing code

For i = 1 To rawcolcount
    multiple = rawrowcount * (i - 1)
    For k = 1 To rawrowcount

        'Sheets("7.1").Activate          <-- 
        'ActiveSheet.Range("A9").Select          <--
        'Selection.Offset(k + 1, 0).Select          <--
        'Selection.Copy          <--
        'Sheets("Q_Sheet7.1").Activate          <--
        'ActiveSheet.Range("A1").Select          <--
        'Selection.Offset(k + multiple, 0).Select          <--
        'ActiveSheet.Paste          <--
            'Copy and paste Years 1 to 100

        Sheets("7.1").Activate
        ActiveSheet.Range("A9").Select
        Selection.Offset(k + 1, i).Select
        Selection.Copy
        Sheets("Q_Sheet7.1").Activate
        ActiveSheet.Range("A1").Select
        Selection.Offset(k + multiple, 2).Select
        ActiveSheet.Paste
            'Copy and paste the Cashflow for Years 1 to 100 for
            'each Product

    Next k
        'Repeat for each Product Type



    Sheets("7.1").Activate
    ActiveSheet.Range("A9").Select
    Selection.Offset(2, 0).Select
    Selection.Copy
    Sheets("Q_Sheet7.1").Activate
    ActiveSheet.Range("A1").Select
    Selection.Offset(multiple + 1, 0).Select
    ActiveSheet.Paste
        'Copy & paste the Year for each respective Cashflow




    'Sheets("7.1").Activate
    'ActiveSheet.Range("B7").Select
    'Selection.Offset(0, i).Select
    'Selection.Copy
    'Sheets("Q_Sheet7.1").Activate
    'ActiveSheet.Range("A1").Select
    'Selection.Offset(multiple + 1, 1).Select
    'ActiveSheet.Paste
        'Copy & paste Region for the respective Cashflow

    Sheets("7.1").Activate
    ActiveSheet.Range("A9").Select
    Selection.Offset(1, i).Select
    Selection.Copy
    Sheets("Q_Sheet7.1").Activate
    ActiveSheet.Range("A1").Select
    Selection.Offset(multiple + 1, 1).Select
    ActiveSheet.Paste
        'Copy & paste the Product for each respective Cashflow


    'Sheets("7.1").Activate
    'ActiveSheet.Range("B8").Select
    'Selection.Offset(0, i).Select
    'Selection.Copy
    'Sheets("Q_Sheet7.1").Activate
    'ActiveSheet.Range("A1").Select
    'Selection.Offset(multiple + 1, 3).Select
    'ActiveSheet.Paste
        'Copy & paste Risk for the respective Cashflow

    ActiveSheet.Range(ActiveSheet.Cells(multiple + 2, 1), ActiveSheet.Cells(multiple + 2, 2)).Select
    Selection.AutoFill Destination:=Range(ActiveSheet.Cells(multiple + 2, 1), ActiveSheet.Cells(multiple + 101, 2))
        'Autofill the Region, Product and Product Type for each Cashflow

Next i
    'Repeat for Years 1 to 100

Application.ScreenUpdating = False
    'Do not update screen while executing code





ThisWorkbook.ActiveSheet.Cells.ClearFormats
    'Clear formatting in Output Worksheet

Set ws = Nothing

 End Sub

Answer 1

您要做的是远离使用选择/选择等，而是使用基于索引的直接参考，例如Ranges。我也在开始时使用了选择/选择。以下是How to avoid using Select in Excel VBA macros

的一些数据

我不完全确定你的脚本在使用Multiple etc时的作用，但是下面的脚本会将来自Sheet 7.1的Cells 10复制到100并将表格Q_Sheet7.1粘贴到Range A1中： 100它将为第1列到第10列执行此操作。

我相信你可以让它适应你的剧本。

Sub CopyPasteUsingRange()

    Dim oRng As Range
    Dim Sht71 As Worksheet
    Dim ShtQ71 As Worksheet
    Dim rawcolcount As Long

    Set Sht71 = ActiveWorkbook.Worksheets("7.1")
    Set ShtQ71 = ActiveWorkbook.Worksheets("Q_Sheet7.1")

    'just for my example
    rawcolcount = 10

    For i = 1 To rawcolcount

        Set oRng = Range(Sht71.Cells(10, i), Sht71.Cells(110, i))

        oRng.Copy

        ShtQ71.Range(Cells(1, i), Cells(110, i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone

    Next i


End Sub

抵消VBA中的范围

1 个答案: