使用VBA过滤和移动数据
使用VBA过滤和移动数据
提问于 2021-10-12 01:08:34
我正在尝试找到一种方法来快速过滤和剪切单元格的范围到另一个工作表
准确地说：
Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range
Set rng = Range("a2:a100")
For Each cell In rng
If Sheet1.Range("a2").Offset(1) = "DE" Then
Sheet1.Range("b2:f2").Cut Sheet2.Range("b2:f2")
End If
Next cell
End Sub我知道这段代码仅限于Cell(A2)。
我需要我的代码去通过范围("a2:a100")，如果它包含值Exp。"DE“将范围(b2:f2)剪切到下一页
EXP.
如果单元格a2包含"DE“，则需要切割范围("b2:f2")；如果单元格a5包含"DE”，则需要切割范围("b5:f5")。
回答 2
Stack Overflow用户
发布于 2021-10-12 02:31:03
如果您需要剪切和粘贴，很好，只需知道您将需要选择粘贴目标工作表，然后再次选择源工作表。但是，如果您只对单元格的内容感兴趣，那么“传输”值会更简单、更快，如下所示。
Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range
Dim TargetRow As Long
Set rng = Range("a2:a100")
For Each cell In rng
If cell = "DE" Then
TargetRow = cell.Row
Worksheets("Sheet2").Range("B" & TargetRow & ":F" & TargetRow).Value2 = Worksheets("Sheet1").Range("B" & TargetRow & ":F" & TargetRow).Value2
Worksheets("Sheet1").Range("B" & TargetRow & ":F" & TargetRow).ClearContents
End If
Next cell
End SubStack Overflow用户
发布于 2021-10-12 10:38:30
剪切条件行(For Each...Next)
使用数组或AutoFilter的
- 肯定会更有效率。
Option Explicit
Sub CutCriteriaRows()
Const sCol As String = "A"
Const sdCols As String = "B:F"
Const sfRow As Long = 2
Const sCriteria As String = "DE"
Const dCol As String = "B"
Dim sws As Worksheet: Set sws = Sheet1
Dim dws As Worksheet: Set dws = Sheet2
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, sCol).End(xlUp).Row
Dim srCount As Long: srCount = slRow - sfRow + 1
Dim srg As Range: Set srg = sws.Cells(sfRow, sCol).Resize(srCount)
Dim scrg As Range
Dim sCell As Range
For Each sCell In srg.Cells
If CStr(sCell) = sCriteria Then
Set scrg = RefCombinedRange(scrg, sCell)
End If
Next sCell
If scrg Is Nothing Then Exit Sub
Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dCol).End(xlUp).Row
Dim dfCell As Range: Set dfCell = dws.Cells(dlRow + 1, dCol)
With Intersect(scrg.EntireRow, sws.Columns(sdCols))
.Copy dfCell
.EntireRow.Delete
End With
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to a range combined from two ranges.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCombinedRange( _
ByVal CombinedRange As Range, _
ByVal AddRange As Range) _
As Range
If CombinedRange Is Nothing Then
Set RefCombinedRange = AddRange
Else
Set RefCombinedRange = Union(CombinedRange, AddRange)
End If
End Function页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/69533996
复制相关文章
相似问题
腾讯云开发者
