excel - VBA Excel - 想要根据选定的单元格选择 1 行或多行并复制到另一张工作表
问题描述
原谅我的无知,这是我第一次真正潜入vba。我有 3 张 Master 包含带有价格和属性的目录
plist 包含我使用教程创建的搜索按钮来过滤结果。我希望用户能够选择一个或多个显示的单元格,然后单击一个按钮将行复制到新工作表
新建是选定文件的最终目的地。行将按顺序复制,当它们被点击时,从上到下。
我已经搜索并尝试了几个想法,但我的无知确实阻碍了我前进。希望有一个搜索方向或您可以提供的任何帮助。
TLDR:需要代码将选定单元格中的值复制到单独的工作表中。
解决方案
非相邻单元格的行
- 将完整代码复制到标准模块中,例如
Module1
. - 仅运行(或分配给按钮)第一个过程
copyRowsOfSelectedCells
。如果从 VBE 运行,请确保plist
选择了工作表(活动)。'plist' 也是包含按钮的工作表。 - 必要时由第一个程序调用随附的程序。
- 在每个随附过程之前,都有一个方法、属性或函数名称,它们与以下过程最相关,以完成手头的任务。研究(“谷歌”)那些以更好地理解每个程序。
编码
Option Explicit
Sub copyRowsOfSelectedCells()
' Define Destination Worksheet Name.
Const dstName As String = "New"
' Test if Selection is a range (object).
If Not isRange(Selection) Then
GoTo ProcExit
End If
' Define Source Row Ranges.
Dim rng As Range
Set rng = CollectedRowRanges(Selection)
' Define Destination First Cell Range.
Dim cel As Range
Set cel = FirstCell(rng.Worksheet.Parent.Worksheets(dstName))
' Copy from Source Worksheet to Destination Worksheet.
copyRowsToAnotherWorksheet rng, cel
ProcExit:
End Sub
' TypeName Function
Private Function isRange(PossibleRange As Variant) _
As Boolean
If TypeName(PossibleRange) = "Range" Then
isRange = True
Else
Debug.Print "Not a range."
End If
End Function
' Range.Areas Property
Private Function CollectedRowRanges(SourceRange As Range) _
As Range
Dim bRng As Range
Dim rng As Range
Dim cel As Range
For Each rng In SourceRange.Areas
For Each cel In rng.Cells
buildRange bRng, cel.EntireRow
Next cel
Next rng
Set CollectedRowRanges = bRng
End Function
' Application.Union Method
Private Sub buildRange(ByRef BuiltRange As Range, _
AddRange As Range)
If Not BuiltRange Is Nothing Then
Set BuiltRange = Union(BuiltRange, AddRange)
Else
Set BuiltRange = AddRange
End If
End Sub
' Range.Find Method
Private Function FirstCell(Sheet As Worksheet, _
Optional ByVal ColumnIndex As Variant = "A") _
As Range
Dim cel As Range
Set cel = Sheet.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
Set FirstCell = Sheet.Cells(cel.Row, ColumnIndex).Offset(1)
Else
Set FirstCell = Sheet.Cells(1, ColumnIndex)
End If
End Function
' Range.PasteSpecial Method
Private Sub copyRowsToAnotherWorksheet(CopyRows As Range, _
PasteCell As Range)
If Not CopyRows Is Nothing And Not PasteCell Is Nothing Then
Dim PasteRowCell As Range
Set PasteRowCell = PasteCell.Cells(1).Offset(, 1 - PasteCell.Column)
CopyRows.Copy
PasteCell.Worksheet.Activate
PasteRowCell.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End Sub
推荐阅读
- c# - 如何在 C# 中使用 signalR 和 API 在 Angular 7 中集成推送通知?
- javascript - 如何使用音频文件中的 amplitute 为图像大小设置动画?
- bigcommerce - 在模板 bigcommerce 中注销时删除所有购物车项目
- ios - 如何获得实际的键盘高度(键盘高度减去安全区域插图)
- c# - 使用 PhotoCapture Unity C# 拍摄多张照片
- r - 是否可以将 ... 的内容分配给另一个变量?
- string - 如何在 RPGLE 中将字符串与换行符连接起来?
- php - 数组中的多个文本框
- java - Spring Rest:具有多个参数的过滤器 api
- database-design - 存储大量数据以快速请求的最佳方式