根据单元格条目删除单元格和列答案

【问题标题】：Delete cells and columns based on a cell entry根据单元格条目删除单元格和列
【发布时间】：2020-04-05 17:03:29
【问题描述】：

我想删除特定列中的单元格。

Sub do_it()

    Dim sht As Worksheet, n As String, cell, num, tmp, rngDest As Range, i As Integer
    Set sht = ActiveSheet
    n = sht.Range("A1").Value
    i = 0
    For Each cell In sht.Range("A20:A34,D20:D34,H20:H34").Cells
        tmp = cell.Offset(0, 1).Value
        If cell.Value = n And tmp Like "*#-#*" Then
            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))

            'find the next empty cell in the appropriate    row
            Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)

            'make sure not to add before col J
            If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)
            cell.Offset(0, 1).Copy rngDest

            ' This is getting the next number in A/D/H----
            Set tmp = cell.Offset(1, 0)

            ' This is filling up B17 - F18 in order until filled
            If sht.Range("B17").Value = "" Then
                sht.Range("C17").Value = cell.Offset(0, 1).Value
                sht.Range("B17").Value = tmp.Value
            ElseIf sht.Range("C18").Value = "" Then
                sht.Range("C18").Value = cell.Offset(0, 1).Value
                sht.Range("B18").Value = tmp.Value
            ElseIf sht.Range("E17").Value = "" Then
                sht.Range("E17").Value = cell.Offset(0, 1).Value
                sht.Range("D17").Value = tmp.Value
            ElseIf sht.Range("E18").Value = "" Then
                sht.Range("E18").Value = cell.Offset(0, 1).Value
                sht.Range("D18").Value = tmp.Value
            End If

            '---- This clears the B columns  after using the value ----
            Dim rg As Range, rg1 As Range
            If cell.Column = 1 Then
                Set rg = cell.Offset(, 1).Resize(, 1)
                If cell.Column > 1 Then Set rg1 = cell.Offset(, 1).Resize(, 2)
            End If
        End If
    Next cell
    If Not rg Is Nothing Then rg.ClearContents  'will be delete column b
    'If Not rg1 Is Nothing Then  rg1.ClearContents 'will be delete column e,f,g,
End Sub

问题是在复制和粘贴过程后删除了正确的列。

使用 Excel 图片：

当在单元格区域 A20:A34（单元格 B34）中找到在单元格 A1 中输入的数字（在本例中为 8）时，仅在此单元格区域中，我需要在复制后删除单元格 B34 的内容并粘贴。

当数字在单元格区域 D20:D34 和 H20:H34 中找到时，我需要在复制和粘贴功能完成后删除单元格 E20/F20/G20 和 I/J/K。

Excel工作表：

【问题讨论】：

Dim sht As Worksheet, n As String, cell, num, tmp, rngDest As Range 将rngDest 声明为Range，但将cell,num, tmp 声明为Variant。这是你的意图吗？
它有效，但我能问一下问题是什么。我到了那里，但我的 VBA 经验不属于你的任何地方。谢谢你的帮助。
我刚刚检查过，这是我的原件； Sub do_it() Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range Set sht = ActiveSheet n = sht.Range("A1") For Each cell In sht.Range("A15:A30,C15 :C30,E15:E30,G15:G30,I15:I30").Cells tmp = cell.Offset(0, 1).Value 如果 cell.Value = n 和 tmp 一样 "#-# " Then ' 得到第一个数字 num = CLng(Trim(Split(tmp, "-")(0))) Debug.Print "在 " & cell.Address 中找到一个肯定的结果
其余的； '在适当的行中找到下一个空单元格 Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1) '确保不要在 col L 之前添加 If rngDest.Column

标签： excel vba

【解决方案1】：

欢迎加入！

为了达到这个目的：

当单元格 A1 中输入的数字（本例中为 8）在单元格中找到时范围 A20:A34（单元格 B34），仅在此单元格范围内，我需要 B34单元格内容复制粘贴后删除。

当在单元格区域 D20:D34 和 H20:H34 中找到数字时，我需要复制粘贴后要删除的单元格 E20/F20/G20 AND I/J/K 功能完成。

您需要替换这部分代码：

        Dim rg As Range, rg1 As Range
        If cell.Column = 1 Then
            Set rg = cell.Offset(, 1).Resize(, 1)
            If cell.Column > 1 Then Set rg1 = cell.Offset(, 1).Resize(, 2)
        End If

有了这个：

        Select Case cell.Column
        Case 1 'If found in column A, delete the next cell
            cell.Offset(, 1).ClearContents
        Case 4, 8 'If found in column D or H, delete cells E20/F20/G20 AND I/J/K
            Range("D20:D34,H20:H34,I:I,J:J,K:K").ClearContents
        End Select

【讨论】：