1

所以,我有三个非常大的数据列。我希望这些匹配,但列之间有很多不匹配的行。

我想要做的是编写一个循环宏来删除单元格中的内容,F2如果它们不等于A2或中的内容K2。但是,我只能找到有关为范围编写循环宏的详细信息。是否可以在同一个单元格上一遍又一遍地执行命令?到目前为止,我有:

Sub ArrayMatch()
Application.ScreenUpdating = True
Dim F As Range
For Each F In Range("F2:F2043").Cells
 F.Select
 If ActiveCell <> ActiveCell.Offset([0], [-5]) And ActiveCell <> ActiveCell.Offset([0],        [5]) Then
 Selection.Delete Shift:=xlUp      
  Else: Stop
  End If
  Next

目前,我只想在其中任何一个相等时停止代码。但是,按照我在此处定义范围的方式,该代码仅适用于该范围内的所有其他单元格。F2我可以改写这个范围以一遍又一遍地将其余代码应用于单元格吗?

谢谢!我会继续试验我所拥有的,同时热切地等待回复!

4

5 回答 5

2

假设您的输入:

我可以改写此范围以将其余代码一遍又一遍地应用于单元格 F2 吗?

这不是你所期望的。线索是你应该检查范围内的每个单元格,只有在它不符合标准的情况下才移动到下一个。否则该行被删除,你应该留在同一个地方,即不要向下移动,因为如果A1被删除,A2现在变成A1,你应该再次检查它。

下面的代码将完成这项工作(也许您应该修改标准,但想法是这样):

Sub RemoveRows()

Dim i As Long
Dim ActiveCell As Range

i = 2

Do While i <= 2043
    Set ActiveCell = Range("F" & i)
    If ActiveCell <> ActiveCell.Offset([0], [-5]) And ActiveCell <> ActiveCell.Offset([0], [5]) Then
        Selection.Delete Shift:=xlUp
    Else
        i = i + 1
    End If

Loop

End Sub

这是非常相似的任务的示例:https ://www.dropbox.com/s/yp2cwphhhdn3l98/RemoweRows210.xlsm

于 2013-02-11T16:27:17.447 回答
1

尝试使用这样的东西:

Sub checkF()

RowCount = WorksheetFunction.CountA(Range("F2").EntireColumn)

While RowCount >= 1

If Range("F2").Value = Range("A2").Value Or Range("F2").Value = Range("K2").Value Then

    Stop

Else

    Range("F2").Delete Shift:=xlUp


End If

RowCount = RowCount - 1

Wend

End Sub

这将循环遍历直到 F 列中剩下 1 个值,并在任何值匹配时停止。

于 2013-02-11T16:28:02.370 回答
1

这是一个简单的循环,它将执行以下操作:

  1. row 2检索列的所有单元格值A, F and K
  2. 检查值是否F2等于A2K2
    • 如果相等,什么都不做并退出宏
    • 如果不相等,则删除 中的值F2,向上移动单元格,检索新F2值,然后从step 1

这是代码:

Public Sub MatchFirstRow()
Dim fCellValue As String
Dim aCellValue As String
Dim kCellValue As String
Dim shouldCheckAgain As Boolean

'get values of each cell in question
fCellValue = Cells(2, 6).Value
aCellValue = Cells(2, 1).Value
kCellValue = Cells(2, 11).Value
shouldCheckAgain = True

'loop through while the cell in "F" has a value AND the previous value wasn't a match
While Not IsEmpty(fCellValue) And Not fCellValue = "" And shouldCheckAgain
    shouldCheckAgain = False
    'If row values don't match, delete cell in F, shift up, then
    'reinitialize the F cell value for next pass
    If Not StrComp(fCellValue, aCellValue, vbTextCompare) _
        And Not StrComp(fCellValue, kCellValue, vbTextCompare) Then
        Cells(2, 6).Select
        Selection.Delete Shift:=xlUp
        fCellValue = Cells(2, 6).Value
        shouldCheckAgain = True
    End If
Wend
End Sub

只需将此代码粘贴到包含相关列的工作表的 VB 编辑器中。例如,如果Sheet1有列,则打开 Visual Basic 编辑器,双击Sheet1,然后将代码粘贴到那里。

Macros粘贴代码后,您可以通过选择按钮将其作为常规宏运行。

于 2013-02-11T17:55:24.997 回答
1

您应该在没有循环的情况下执行此操作,或者使用

  1. 插入使用 an=OR(F2=K2,F2=A2)返回TrueFalse结果的工作列,然后使用AutoFilter手动或使用删除 False 结果
  2. 变得时髦并直接在下面的变体数组中执行(1),然后将变体数组转储回原始范围内

代码

Sub GetEm()
X = Filter(Application.Transpose(Application.Evaluate("=IF(--(F2:F2043=A2:A2043)+--(F2:F2043=K2:K2043),F2:F2043,""x"")")), "x", False)
Range("F2:F2043").Value = vbNullString
[f2].Resize(UBound(X), 1).Value = Application.Transpose(X)
End Sub
于 2013-02-12T10:10:47.490 回答
0

工作表的Worksheet_Change子部分应该在这里工作。每当该工作表中的单元格发生更改时,都会调用该 sub。

'This sub placed in one of the "Sheet1"/"Sheet2"/... objects in the list of
'Microsoft Excel Object in the VBA Editor will be called everytime you change
'a cell value in the corresponding sheet.
'"Target" is the effected cell.
Private Sub Worksheet_Change(ByVal Target As Range)
    'Check that Target is cell F2 (6th column, 2nd row)
    If Target.Row = 2 And Target.Column = 6 Then
        'If this is the cell we are looking for call the sub ValidateF2
        ValidateF2
    End If
End Sub

和:

Sub ValidateF2()
    'Check that the value of F2 is not equal to A2 or K2
    If Not (Range("F2").Value = Range("A2").Value Or Range("K2").Value = Range("K2").Value) Then
        'Set the value of F2 to "" (empty)
        Range("F2").Value = ""
    End If
End Sub
于 2013-02-11T16:07:57.923 回答