我必须从一个Excel工作表中选择数据并复制到另一个工作表中,但是我需要在复制数据的过程中实现以下目的:
>对于原始工作表的每一行,按列选择单元格(我可以预定义,也许使用数组或其他内容).
>操纵数据以在新工作表中更改其方向.见下面的截图.
很难准确解释我的意思,所以我希望我的截图能够传达我需要的东西.
对于每一行都有一个通道值,我需要通过通道对所有结果进行排序和压缩.还需要针对限制检查结果,但是我可以在解决此问题后将其交叉.
我在下面有我的代码,我感谢可能有错误,因为这是我的第一个脚本.没关系按渠道订购数据我到目前为止都在努力甚至选择我想要的列并将它们完全复制到新工作表中.
代码的第一部分是检查并创建一个新的工作表.之后,它继续定义变量和数组,我可以预定义我想要的列.它完成了一个循环,它检查x行数(虽然我确实希望它迭代尽可能多的行),并且内部每行有另一个循环,根据我的预定义列抓取单元格.
在调试时,它会在循环内部底部的工作表复制功能中显示为对象或应用程序错误.我不确定我哪里出错了.我哪里出错了,是否有更好的方法来攻击它?
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
最佳答案 有多种方法可以解决这个问题!以下三个可以在
this file中找到.
1.数据透视表
> Insert tab-> Tables-> PivotTable
>选择数据作为分析范围,然后单击“确定”
>将字段模式拖到“行标签”框,将“通道”拖到“列标签”列,将“结果”拖到“值”
>数据透视表工具 – >设计选项卡 – >布局 – >总计 – >关闭行和列
完成!
2.公式
如果已知模式和通道的名称,则此解决方案仅适用:
>将所有模式名称放在第一列中,将所有通道名称放在第一行中,即创建标题行.在下面的公式中,我假设标题行是第1行,标题列是Sheet2中的A,并且数据是在Sheet1中,从单元格A1开始
>在单元格B2中,输入以下公式:
=INDEX(Sheet1!$D$2:$D$10,MATCH($A2&"_"&B$1,Sheet1!$A$2:$A$10&"_"&Sheet1!$C$2:$C$10,0))
这是一个数组公式,即使用Ctrl-Shift-Enter输入它
3.复制表中所有剩余单元格的公式
3.宏观
这个宏将完成这项工作 – 虽然它假定模式和通道已排序.您需要命名结果表rngHeader的左上角单元格,然后运行以下代码:
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