VBA - 系统生成报告修改
VBA - System generated report amendments
我在创建将修改系统生成的报告的宏时遇到了一些问题。
我希望能够将我的系统生成的报告粘贴到 excel 中,并通过按下一个按钮(宏),它将 select 我的数据的每隔一行并将数字复制到另一个选项卡,然后我希望它删除这些备用行。
然后它会转到另一个选项卡并提取这些数字并将它们粘贴到外部栏中。
我已经尝试通过录制宏来做到这一点,但我不确定如何将其获取到 select 不同范围的数据。
任何人都可以提供任何帮助,我们将不胜感激。
保拉
下面的代码应该可以满足您的需求。它检查你的范围中的第一行是奇数还是偶数,这决定了它移动到哪一列("series" 中的第一行有值,移动到第一列,第二行,有总计, 移动到第二列)。
如果有帮助请告诉我。
Sub MoveAlternatingToNewTab()
Dim wsOrigin As Worksheet
Dim wsDestination As Worksheet
Dim rngOrigin As Range
Dim isFIRST_ROW_ODD As Integer
Dim cel As Range
Dim nLastRow As Long
Set wsOrigin = Worksheets("Sheet1")
Set wsDestination = Worksheets("Sheet2")
Set rngOrigin = wsOrigin.Range("A1:A12") 'Change this to suit your needs
'Below variable stores whether the first row of the rngOrigin variable
'Is odd or even. Used to know which column the data should be move to
isFIRST_ROW_ODD = rngOrigin.Rows(1).Row Mod 2
For Each cel In rngOrigin
If cel.Row Mod 2 = isFIRST_ROW_ODD Then
nLastRow = wsDestination.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsDestination.Cells(nLastRow, 1) = cel.Value
Else
wsDestination.Cells(nLastRow, 2) = cel.Value
End If
Next cel
End Sub
[注意]要回答有关删除备用行的评论中的后续问题:
要删除交替行,我更喜欢从数据集的底部开始,然后向上移动。这样做可以防止工作表中的变化(由于删除)影响循环。首先找到要删除的最后一行,然后向后循环,以2为增量步进。
Sub DeleteAlternateRows()
Dim nLastRow As Long
nLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
If nLastRow Mod 2 = 0 Then
nLastRow = nLastRow - 1
End If
For i = nLastRow To 1 Step -2
Worksheets("Sheet1").Rows(i).Delete
Next i
End Sub
我在创建将修改系统生成的报告的宏时遇到了一些问题。
我希望能够将我的系统生成的报告粘贴到 excel 中,并通过按下一个按钮(宏),它将 select 我的数据的每隔一行并将数字复制到另一个选项卡,然后我希望它删除这些备用行。
然后它会转到另一个选项卡并提取这些数字并将它们粘贴到外部栏中。
我已经尝试通过录制宏来做到这一点,但我不确定如何将其获取到 select 不同范围的数据。
任何人都可以提供任何帮助,我们将不胜感激。
保拉
下面的代码应该可以满足您的需求。它检查你的范围中的第一行是奇数还是偶数,这决定了它移动到哪一列("series" 中的第一行有值,移动到第一列,第二行,有总计, 移动到第二列)。
如果有帮助请告诉我。
Sub MoveAlternatingToNewTab()
Dim wsOrigin As Worksheet
Dim wsDestination As Worksheet
Dim rngOrigin As Range
Dim isFIRST_ROW_ODD As Integer
Dim cel As Range
Dim nLastRow As Long
Set wsOrigin = Worksheets("Sheet1")
Set wsDestination = Worksheets("Sheet2")
Set rngOrigin = wsOrigin.Range("A1:A12") 'Change this to suit your needs
'Below variable stores whether the first row of the rngOrigin variable
'Is odd or even. Used to know which column the data should be move to
isFIRST_ROW_ODD = rngOrigin.Rows(1).Row Mod 2
For Each cel In rngOrigin
If cel.Row Mod 2 = isFIRST_ROW_ODD Then
nLastRow = wsDestination.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsDestination.Cells(nLastRow, 1) = cel.Value
Else
wsDestination.Cells(nLastRow, 2) = cel.Value
End If
Next cel
End Sub
[注意]要回答有关删除备用行的评论中的后续问题:
要删除交替行,我更喜欢从数据集的底部开始,然后向上移动。这样做可以防止工作表中的变化(由于删除)影响循环。首先找到要删除的最后一行,然后向后循环,以2为增量步进。
Sub DeleteAlternateRows()
Dim nLastRow As Long
nLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
If nLastRow Mod 2 = 0 Then
nLastRow = nLastRow - 1
End If
For i = nLastRow To 1 Step -2
Worksheets("Sheet1").Rows(i).Delete
Next i
End Sub