对于每一行，按预定义的列复制特定的单元格，并将其粘贴到单独的工作表中备用预定义的列中

我必须从一个Excel工作表中select数据并将其复制到不同的工作表中，但是在复制数据的过程中，我需要实现以下function：

• 对于原始工作表的每一行，按列（我可以预先定义，也许使用一个数组或某物）select单元格。

• 操作数据以更改新工作表中的方向。 看下面的截图。

我很难解释我的意思，所以我希望我的截图能够传达我所需要的东西。

对于每一行都有一个通道值，我需要通过通道来sorting和压缩所有的结果。 还有一个需要检查结果的限制，但我可以跨越这个问题解决后。

我有我的代码如下，我明白，可能有错误，因为这是我的第一个脚本。 不要介意按频道sorting数据，我到目前为止挣扎甚至select我想要的列，并将它们完全复制到新的工作表。

代码的第一部分是检查并创build一个新的工作表。 之后，它继续定义可以预定义我想要的列的variables和数组。 它完成了一个循环，通过x行检查（虽然我希望它遍历所有行数），内部还有另一个循环，根据我预定义的列抓取单元格。

debugging时，在循环底部的表单复制function中显示为对象或应用程序错误。 我不确定我要去哪里错。 我在哪里错了，是否有更好的方法来攻击？

Sub Process_Results() 'User defines the worksheets for this script sourcedatasheet_name = InputBox("Enter the customer data sheet name: ", "Enter Worksheet Name") For rep = 1 To (Worksheets.Count) If LCase(Sheets(rep).Name) = LCase(sourcedatasheet_name) Then Exit For ElseIf (rep = Worksheets.Count) And (LCase(Sheets(rep).Name) <> LCase(sourcedatasheet_name)) Then MsgBox "This sheet does not exist!" Exit Sub End If Next destinationdatasheet_name = InputBox("Enter the destination worksheet name to write the data to: ", "Enter Destination Worksheet Name") For rep = 1 To (Worksheets.Count) If LCase(Sheets(rep).Name) = LCase(destinationdatasheet_name) Then MsgBox "This sheet already exists!" Exit Sub End If Next Sheets.Add After:=Sheets(Sheets.Count) Sheets(ActiveSheet.Name).Name = destinationdatasheet_name 'These are the variables for referencing data sets in the source sheet Dim source_testmodel Dim source_testcasename Dim source_measurementname Dim source_carrierfrequency Dim source_limitlow Dim source_limithigh Dim source_measuredresult Dim source_measurementunit 'These are the variables for referencing data set columns in the processed data sheet Dim destination_testmodel Dim destination_testcasename Dim destination_measurementname Dim destination_carrierfrequency_bottomchannel Dim destination_carrierfrequency_middlechannel Dim destination_carrierfrequency_topchannel Dim destination_measuredresult 'Define the column number and cell column reference for each data set that will be used to retrieve information from the source sheet source_testmodel = 9 source_testname = 11 source_measurementname = 12 source_measuredcarrierfrequency = 13 source_measurementlimitlow = 15 source_measurementlimithigh = 16 source_measuredresult = 17 source_measurementunit = 18 Dim array_source_fields(8) As Variant array_source_fields(1) = source_testmodel array_source_fields(2) = source_testname array_source_fields(3) = source_measurementname array_source_fields(4) = source_measuredcarrierfrequency array_source_fields(5) = source_measurementlimitlow array_source_fields(6) = source_measurementlimithigh array_source_fields(7) = source_measuredresult array_source_fields(8) = source_measurementunit 'Define the column number and cell column reference for each data set that will be used to write information to the processing sheet destination_testmodel = 1 destination_testname = 2 destination_measurementname = 3 destination_channelbottom = 4 destination_channelmiddle = 5 destination_channeltop = 6 Dim array_processed_fields(6) As Variant array_processed_fields(1) = destination_testmodel array_processed_fields(2) = destination_testname array_processed_fields(3) = destination_measurementname array_processed_fields(4) = destination_channelbottom array_processed_fields(5) = destination_channelmiddle array_processed_fields(6) = destination_channeltop 'Start processing data Dim y As Variant Dim lastrow As Long For x = 1 To 100 'row 'lastrow=activesheet.usedrange.specialcells(xlCellTypeLastCell) For Each y In array_source_fields 'y = LBound(Application.Transpose(array_source_fields)) To UBound(Application.Transpose(array_source_fields)) Sheets(sourcedatasheet_name).Cells(x, y).Copy Destination:=Sheets(destinationdatasheet_name).Cells(x, y) Next y Next x End Sub 

Answer 1

有多种方法可以解决这个问题！ 以下三个可以在这个文件中find。

1.数据透视表

1. 插入选项卡 – > 表格 – >数据透视表
2. select你的数据作为范围来分析，然后点击好的
3. 将字段Mode拖到“行标签”框中，将“通道”拖动到“列标签”和“结果”列中的“值”
4. 数据透视表工具 – > devise选项卡 – > 布局 – > 总计 – > closures行和列

完成！

2.公式

该解决scheme仅适用于已知模式和频道的名称：

1. 将所有的模式名称放在第一列，即第一行的所有通道名称，即创build标题行。 在下面的公式中，假定标题行是第1行，并且标题列是工作表2中的A，并且您的数据位于Sheet1中，从单元格A1开始
2. 在单元格B2中，input以下公式：

 = INDEX（Sheet 1中$ d $ 2：$ d $ 10 MATCH（$ A2＆ “_” ＆B $ 1，工作表Sheet $ A $ 2：$ A $ 10 “_” ＆Sheet 1中$ C $ 2：$ C $ 10,0））

这是一个数组公式，也就是用Ctrl – Shift – Enterinput它。3.将公式中所有剩余的单元格复制到表格中

3.macros

这个macros将做这个工作 – 尽pipe它假设模式和渠道是sorting的。 您需要命名结果表rngHeader的左上angular单元格，然后运行以下代码：

 Sub FillTable() Dim rngSource As Range, rngTarget As Range Dim lngModeCount As Long, lngChannelCount As Long Set rngSource = Range("A2") Set rngTarget = Range("rngHeader") 'Clear old result With rngTarget If .Offset(1) <> "" And .Offset(, 1) <> "" Then .Resize(.End(xlDown).Row - .Row + 1, .End(xlToRight).Column - .Column + 1).Clear rngTarget = "(cell is named ""rngHeader"")" End If End With While rngSource.Value <> "" If rngSource.Offset(-1) <> rngSource Then lngModeCount = lngModeCount + 1 lngChannelCount = 0 rngTarget.Offset(lngModeCount) = rngSource rngTarget.Offset(lngModeCount).Font.Bold = True End If lngChannelCount = lngChannelCount + 1 If lngModeCount = 1 Then rngTarget.Offset(, lngChannelCount) = rngSource.Offset(, 2) rngTarget.Offset(, lngChannelCount).Font.Bold = True End If rngTarget.Offset(lngModeCount, lngChannelCount) = rngSource.Offset(, 3) Set rngSource = rngSource.Offset(1) Wend End Sub 

Answer 2

顺便说一句，这里有一些代码可以做你想做的事情：

 Const FIRST_CELL_IN_SOURCE_DATA = "$A$4" Const FIRST_CELL_IN_DEST_DATA = "$A$2" Const COL_SOURCE_MODE = 0 Const COL_SOURCE_DESC = 1 Const COL_SOURCE_CHANNEL = 2 Const COL_SOURCE_RESULT = 3 Const COL_SOURCE_LIMIT = 4 Const COL_DEST_MODE = 1 Const COL_DEST_DESC = 1 Const COL_DEST_RESULT = 4 Const COL_DEST_FIRST_CHANNEL = 3 Const ROW_DEST_HEADER = 1 Private wksSource As Worksheet Private wksDest As Worksheet Sub Process_Results() If GetSourceSheet = False Then Exit Sub If CreateDestinationSheet = False Then Exit Sub CopyDataSet End Sub Private Function GetSourceSheet() As String 'User defines the worksheets for this script sourcedatasheet_name = InputBox("Enter the customer data sheet name: ", "Enter Worksheet Name") For rep = 1 To (Worksheets.Count) If LCase(Sheets(rep).Name) = LCase(sourcedatasheet_name) Then Exit For ElseIf (rep = Worksheets.Count) And (LCase(Sheets(rep).Name) <> LCase(sourcedatasheet_name)) Then MsgBox "This sheet does not exist!" Exit Function End If Next Set wksSource = Sheets(sourcedatasheet_name) GetSourceSheet = True End Function Private Function CreateDestinationSheet() As String destinationdatasheet_name = InputBox("Enter the destination worksheet name to write the data to: ", "Enter Destination Worksheet Name") For rep = 1 To (Worksheets.Count) If LCase(Sheets(rep).Name) = LCase(destinationdatasheet_name) Then MsgBox "This sheet already exists!" Exit Function End If Next Sheets.Add After:=Sheets(Sheets.Count) Sheets(ActiveSheet.Name).Name = destinationdatasheet_name Set wksDest = Sheets(destinationdatasheet_name) AddHeaders CreateDestinationSheet = True End Function Private Sub CopyDataSet() Dim rngSourceRange As Range Dim rngDestRange As Range Set rngSourceRange = wksSource.Range(FIRST_CELL_IN_SOURCE_DATA) Set rngDestRange = wksDest.Range(FIRST_CELL_IN_DEST_DATA) rngDestRange.Activate Do Until rngSourceRange.Value = "" CopyRowToDest rngSourceRange, rngDestRange Set rngSourceRange = rngSourceRange.Offset(1) Loop End Sub Private Sub AddHeaders() Dim rng As Range Set rng = wksDest.Cells(ROW_DEST_HEADER, 1) rng.Value = "Mode" rng.Offset(, 1).Value = "Test" End Sub Private Function GetColumnForChannel(ByVal Channel As String) As Long Dim rng As Range Set rng = wksDest.Cells(ROW_DEST_HEADER, COL_DEST_FIRST_CHANNEL) Do Until rng.Value = "" If rng.Value = Channel Then GetColumnForChannel = rng.Column - 1 Exit Function End If Set rng = rng.Offset(, 1) Loop rng.Value = Channel GetColumnForChannel = rng.Column - 1 End Function Private Sub MoveToModeRow(ByVal Mode As String) If ActiveCell.Value = Mode Then Exit Sub If ActiveCell.Address = FIRST_CELL_IN_DEST_DATA And ActiveCell.Value = "" Then ActiveCell.Value = Mode Exit Sub End If If Val(ActiveCell.Value) < Val(Mode) And ActiveCell.Offset(1).Value = "" Then ActiveCell.Offset(1).Activate ActiveCell.Value = Mode Exit Sub End If Dim rng As Range Set rng = wksDest.Range(FIRST_CELL_IN_DEST_DATA) Do Until rng.Value = "" If rng.Value = Mode Then rng.Activate Exit Sub End If Set rng = rng.Offset(1) Loop rng.Value = Mode rng.Activate End Sub Private Sub CopyRowToDest(ByRef rngSourceRange As Range, ByRef rngDestRange As Range) MoveToModeRow rngSourceRange.Offset(, COL_SOURCE_MODE).Value Dim lngCol As Long lngCol = GetColumnForChannel(rngSourceRange.Offset(, COL_SOURCE_CHANNEL).Value) ActiveCell.Offset(, lngCol).Value = rngSourceRange.Offset(, COL_SOURCE_RESULT).Value ActiveCell.Offset(, COL_DEST_DESC).Value = rngSourceRange.Offset(, COL_SOURCE_DESC).Value End Sub