Question

这是一个演示问题的屏幕截图

以下是电子表格的副本。

https://www.dropbox.com/s/9qihuvbe5c80su4/Data_rearrange_trial.xlsm?dl=0

每个电子表格都与一个大学“单位”相关，并保存一组“特征”中学生样本的表现数据。这些特征按照彼此相邻的列进行组织，出于数据处理的目的，我需要复制它们，使它们都在一个列中。我还需要在复制的“特征”数据旁边复制每个学生的“标签”数据行。我还需要复制特征名称或标签，并将它们粘贴到适当的位置。

1-我使用用户输入来定义需要复制的参数（所有电子表格都有类似的设置）。有没有办法检测复制范围和粘贴范围的参数？

2-在宏的某个时刻，我需要告诉它我正在使用的工作表的名称（Set TargetWorkSheet = Worksheets（“输入数据”））。有没有办法消除对“输入数据”的明确命名的需要，例如（ActiveWorkBook）或类似的东西？

3-这是问题2的后续内容。我将在多个电子表格中使用宏。什么是使其普遍可用的最佳方式，因此我不必将代码重复复制并粘贴到电子表格中。

4-有没有更好的方法来实现这个宏？我确保使代码有效（例如，我从一个单元循环到另一个单元，然后将其更改为在范围上工作）。还有我错过的其他好习惯吗？

Sub Rearrange()

Dim CopyRowNr As Integer                'Variable determining the row coordinate where data is to copied from.
Dim CopyColNr As Integer                'Variable determining the column coordinate where data is to be copied from.
Dim RecordsNr As Integer                'Variable determining the number of students and thus sets the number of row copy operations (nested while loop)
Dim TraitsNr As Integer                 'Variable determining the number of traits to be copied and sets the number of copy repetitions (first while loop)
Dim PasteRowNr As Integer               'Variable determining the row coordinate where the data is to pasted to.
Dim PasteColNr As Integer               'Variable determining the column coordinate where the data is to be pasted to.
Dim CopyRowCounter As Integer           'Counter for the nested while loop that cycles through each data-set (comprised of 3 columns and multiple rows).
Dim CopyColCounter As Integer           'Counter for the first while loop that cycles from one trait data-set to the next
Dim CopyColCounterLim As Integer        'The iteration limit for the first while loop
Dim CopyRowCounterLim As Integer        'The iteration limit for the nested while loop
Dim CourseRowLabelCol As Integer        'Variable to determine row coordinates for copying the row labels
Dim CourseRowLabelRow As Integer
Dim UnitRowLabelCol As Integer
Dim UnitRowLabelRow As Integer




Dim TraitsCopyRange As Range            'Range to copy traits data from
Dim TraitsPasteRange As Range           'Range to paste traits data into
Dim CourseRowLabelsCopyRange As Range   'Range to copy course info from
Dim CourseRowLabelsPasteRange As Range  'Range to paste course info into
Dim UnitRowLabelsCopyRange As Range     'Range to copy unit info from
Dim UnitRowLabelsPasteRange As Range    'Range to copy unit info into

Dim TargetWorkSheet As Worksheet

Set TargetWorkSheet = Worksheets("Input Data")

RecordsNr = InputBox("Enter the number of students recorded")       'User input to define operational parameters x 3
CopyRowNr = InputBox("Enter the number of first row of data")
CopyColNr = InputBox("Enter number of first column of data")
TraitsNr = InputBox("Enter the number of AoL traits recorded") - 1  'User input, but '1' is deducted because the first trait column remains in place and doesn't need copying.


PasteRowNr = CopyRowNr + RecordsNr                                           'Operational parameters calculated from input values x 7
PasteColNr = CopyColNr - 3                                                   ' 3 column offset from the copy column. Consider pros and cons of defining the offset of 3 as a variable.
CopyColCounterLim = TraitsNr
CourseRowLabelCol = CopyColNr - 6                                            ' 6 column offset from the copy column
CourseRowLabelRow = CopyRowNr
UnitRowLabelCol = CopyColNr - 11                                             ' 11 Column offset from the copy column
UnitRowLabelRow = CopyRowNr

Cells(CopyRowNr - 2, CopyColNr - 3).Copy        ' One-time operation to copy the trait number of the first trait column to the row label area
Cells(CopyRowNr, PasteColNr - 4).Select
ActiveSheet.Paste


While CopyColCounter < CopyColCounterLim

       Cells(CopyRowNr - 2, CopyColNr).Copy            'Copy PLO Trait labels
       Cells(PasteRowNr, PasteColNr - 4).Select        'Select and paste PLO Trait with a column offset of -4 and on the same row as the paste row for this iteration.
       ActiveSheet.Paste

        With TargetWorkSheet

          Set TraitsCopyRange = Range(Cells(CopyRowNr, CopyColNr), Cells(CopyRowNr + RecordsNr, CopyColNr + 2))             'Defining the ranges to copy the traits from and paste them into as offsets of the main parameters input
          Set TraitsPasteRange = Range(Cells(PasteRowNr, PasteColNr), Cells(PasteRowNr + RecordsNr, PasteColNr + 2))

            TraitsCopyRange.Cut                 'Copy and paste trait data
            TraitsPasteRange.Select
            ActiveSheet.Paste

          Set CourseRowLabelsCopyRange = Range(Cells(CopyRowNr, CourseRowLabelCol), Cells(CopyRowNr + RecordsNr - 1, CourseRowLabelCol + 2))  'Defining the ranges to copy the course info row labels from and paste them into as offsets of the main parameters input
          Set CourseRowLabelsPasteRange = Range(Cells(PasteRowNr, CourseRowLabelCol), Cells(PasteRowNr + RecordsNr, CourseRowLabelCol + 2))

            CourseRowLabelsCopyRange.Copy
            CourseRowLabelsPasteRange.Select
            ActiveSheet.Paste

          Set UnitRowLabelsCopyRange = Range(Cells(CopyRowNr, UnitRowLabelCol), Cells(CopyRowNr + RecordsNr - 1, UnitRowLabelCol + 1)) 'Defining the ranges to copy the unit info row labels from and paste them into as offsets of the main parameters input
          Set UnitRowLabelsPasteRange = Range(Cells(PasteRowNr, UnitRowLabelCol), Cells(PasteRowNr + RecordsNr, UnitRowLabelCol + 1))

            UnitRowLabelsCopyRange.Copy
            UnitRowLabelsPasteRange.Select
            ActiveSheet.Paste

        PasteRowNr = PasteRowNr + RecordsNr 'Shifting the PasteRowNumber to the next position in the spreadsheet.

        End With

    CopyColNr = CopyColNr + 3 'Shifting the Copy Column Number to the next position in the spreadsheet


    'CopyRowCounter = 0
    CopyColCounter = CopyColCounter + 1

Wend


End Sub

Answer 1

对于此类任务，Microsoft在Excel 2016中引入了GetAndTransform。要在早期版本（2010和2013）中使用此功能，您必须将Power Query安装为加载项。

看起来你基本上必须在这里对多个列执行数据透视操作。请在此处找到示例：https://www.dropbox.com/s/8u0i7mo2kycia4q/SO_Data_rearrange_trial.xlsm?dl=0

代码很基本：

let
    Source = Excel.CurrentWorkbook(){[Name="Data"]}[Content],
    CreateStudentID = Table.AddColumn(Source, "StudID", each Text.Replace([MMU ID Number], "MMUID", "")),
    ChangeToNumber = Table.TransformColumnTypes(CreateStudentID,{{"StudID", type number}}),
    FillDownPLO = Table.FillDown(ChangeToNumber,{"PLO"}),
    UnpivotCat = Table.UnpivotOtherColumns(FillDownPLO, {"Unit Code", "Unit Description", "Department", "Cluster", "PLO", "Course Name", "Course Code", "MMU ID Number", "StudID"}, "Attribute", "Value"),
    MergePLOWithCat = Table.CombineColumns(UnpivotCat,{"PLO", "Attribute"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Merged"),
    ReorderCols = Table.ReorderColumns(MergePLOWithCat,{"StudID", "Unit Code", "Unit Description", "Department", "Cluster", "Course Name", "Course Code", "MMU ID Number", "Merged", "Value"}),
    Pivot = Table.Pivot(ReorderCols, List.Distinct(ReorderCols[Merged]), "Merged", "Value")
in
    Pivot

实际上你只能使用UI来完成这一切。此外，如果全部用于进一步的数据处理，您可以将不同工作簿中的数据全部收集到一个Excel工作表中。

复制并粘贴数据以重新排列电子表格

1 个答案: