如何用循环简化跨表格复制转置数据的重复代码？

Hey there! Let's break down how to solve this transpose-and-copy problem with loops to make your code way more efficient, and then extend it to handle multiple table pairs easily.

First, let's nail down the patterns you mentioned #

Looking at your data positions:

• "Daily Dotcom" columns: Groups of 3 columns, starting at 3, then skipping 1 column between groups (3-5 → 7-9 → 11-13...). So each group's starting column is 3 + 4 * (group index) (since 3 to 7 is +4, 7 to 11 is +4, etc.).
• "dotFigures" rows: Groups of 3 rows, starting at 2, then skipping 2 rows between groups (2-4 →7-9 →12-14...). Each group's starting row is 2 +5 * (group index) (2 to7 is +5,7 to12 is +5, etc.).

Loop implementation for the first table pair (VBA example, since this is typical for Excel table operations) #

We'll write a loop that iterates over each group, copies the 3 columns, transposes them, and pastes to the target 3 rows:

Sub TransposeCopy_DailyToDot()
    Dim sourceSheet As Worksheet, targetSheet As Worksheet
    Dim totalGroups As Integer
    Dim groupIndex As Integer
    Dim sourceStartCol As Integer, targetStartRow As Integer
    
    ' Set your source and target worksheets
    Set sourceSheet = ThisWorkbook.Worksheets("Daily Dotcom")
    Set targetSheet = ThisWorkbook.Worksheets("dotFigures")
    
    ' Set how many groups of 3 columns/rows you have (adjust this to your actual data)
    totalGroups = 3
    
    For groupIndex = 0 To totalGroups - 1
        ' Calculate starting column for current group in source sheet
        sourceStartCol = 3 + (groupIndex * 4)
        ' Calculate starting row for current group in target sheet
        targetStartRow = 2 + (groupIndex * 5)
        
        ' Copy the 3 columns from source, transpose and paste values to target
        sourceSheet.Range(sourceSheet.Cells(1, sourceStartCol), sourceSheet.Cells(1, sourceStartCol + 2)).Copy
        targetSheet.Cells(targetStartRow, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Next groupIndex
    
    ' Clean up copy mode
    Application.CutCopyMode = False
End Sub

Extend to other tables (like "dailySeasonal") #

To avoid repeating code for other table pairs, wrap the core logic in a reusable subroutine, then call it for each pair:

' Reusable function to handle any source-target table pair
Sub TransposeCopy_Generic(sourceSheetName As String, targetSheetName As String, totalGroups As Integer)
    Dim sourceSheet As Worksheet, targetSheet As Worksheet
    Dim groupIndex As Integer
    Dim sourceStartCol As Integer, targetStartRow As Integer
    
    Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)
    Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
    
    For groupIndex = 0 To totalGroups - 1
        sourceStartCol = 3 + (groupIndex * 4)
        targetStartRow = 2 + (groupIndex * 5)
        
        sourceSheet.Range(sourceSheet.Cells(1, sourceStartCol), sourceSheet.Cells(1, sourceStartCol + 2)).Copy
        targetSheet.Cells(targetStartRow, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Next groupIndex
    
    Application.CutCopyMode = False
End Sub

' Main sub to run all your table pairs
Sub ProcessAllTables()
    ' Process Daily Dotcom → dotFigures
    TransposeCopy_Generic "Daily Dotcom", "dotFigures", 3
    
    ' Process Daily Dotcom → dailySeasonal
    TransposeCopy_Generic "Daily Dotcom", "dailySeasonal", 3
    
    ' Add more calls here for other table pairs, e.g.:
    ' TransposeCopy_Generic "YourSourceSheet", "YourTargetSheet", 3
End Sub

Quick notes to tweak for your data #

• If your source data isn't in row 1 of "Daily Dotcom", change the 1 in sourceSheet.Cells(1, sourceStartCol) to your actual source row number.
• If your target data isn't in column 1 of the target sheets, change the 1 in targetSheet.Cells(targetStartRow, 1) to your actual target column number.
• Always test with totalGroups = 1 first to verify the logic works for one group before scaling up.

内容的提问来源于stack exchange，提问作者Lee Read