Question

我正尝试在A列中查看“ outside”一词是否存在。如果不是，则移至J列，如果该单元格不是空白，则移动该单元格，然后将该行中的所有单元格向左移动。以下是我所拥有的，但不起作用。我的代码有什么问题？

Sub CleanReportStep5a()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("copied") 
Dim i As Long
      For i = 19 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        If ws.Range("A" & i) <> "Outside" Then
            If ws.Range("J" & i) <> " " Then
                ws.Range("J" & i).Delete Shift:=xlShiftleft
               End If
      End If
    Next i
End Sub

Answer 1

编辑：

我还注意到，如果ws.Range("A" & ws.Rows.Count).End(xlUp).Row 小于19，则宏将结束，因为您要查看的范围从19（For i = 19 To开始，但是我想您知道这一点：）
.Offset(0, -1)决定您要移动范围的步长。-1 =左移一步。

如果您要移动所有值（向左移动1步）并保留单元格的公式/格式，则应应用该值。

Sub CutPasteAll()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("copied")
Dim i As Long
Dim lcol As Long

For i = 19 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row 'notice if this is smaller than 19 it will ends here
    If ws.Range("A" & i) <> "Outside" Then
        If ws.Cells(i, "J") <> "" Then
            lcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column 'Find the last column to cut
            'This will keep all formattings and formulas when moved
            ws.Range(Cells(i, "J"), Cells(i, (ws.Cells(1, Columns.Count).End(xlToLeft).Column))).Cut _
            ws.Range(ws.Cells(i, "J"), ws.Cells(i, (ws.Cells(1, Columns.Count).End(xlToLeft).Column))).Offset(0, -1) 'First line is cut, second paste. Adjust -1 in Offset(0,-1) to decide how many steps to the left the row should be shifted.
        End If
    End If
Next i
End Sub

如果您要移动所有值（向左移动1步），并且不，请保持 公式/格式 的单元格应该应用。

Sub CutPasteValues() Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("copied") Dim i As Long Dim lcol As Long For i = 19 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row 'notice if this is smaller than 19 it will ends here If ws.Range("A" & i) <> "Outside" Then If ws.Cells(i, "J") <> "" Then lcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column 'Find the last column to cut 'This will only paste values, formatting and formulas will be lost. ws.Range(Cells(i, "J"), Cells(i, (ws.Cells(1, Columns.Count).End(xlToLeft).Column + 2))).Copy 'Copy range Application.DisplayAlerts = False 'Hide warnings like "There's already data here.Do you want to replace it?" ws.Range(ws.Cells(i, "J"), ws.Cells(i, (ws.Cells(1, Columns.Count).End(xlToLeft).Column))).Offset(0, -1).PasteSpecial xlPasteValues 'Paste values according to your settings. Adjust -1 in Offset(0,-1) to decide how many steps to the left the row should be shifted. Application.DisplayAlerts = True 'Turn on warnings again Application.CutCopyMode = False 'Deselect all cells End If End If Next i End Sub

我的结果（注意，未评估第19行以上的所有内容）：

Answer 2

我将使用Range对象的SpecialCells()方法并循环遍历J列，而不是从第19行唐纳德中清空单元格（请参阅注释以获取解释）：

Option Explicit

Sub CleanReportStep5a()
    Dim rngToScan As Range

    With ThisWorkbook.Sheets("copied") 'reference wante sheet
        On Error Resume Next ' prevent any error possibly raised from subsequent statement from stoppoing the code
        Set rngToScan = Intersect(.Range("J:J").SpecialCells(xlCellTypeConstants), .Rows("19:" & .Cells(.Rows.Count, 10).End(xlUp).Row)) ' set the range to scan to referenced sheet column J not empty cells from row 19 down to last not empty one
        On Error GoTo 0 ' get default error handling back
    End With

    If rngToScan Is Nothing Then Exit Sub ' if no range to be scanned then exit sub

    Dim cell As Range
    For Each cell In rngToScan ' loop through range to scan
        If cell.Offset(, -9).Value2 <> "Outside" Then cell.Delete Shift:=xlToLeft ' if value in column A and current cell row is not "Outside" then delete current cell
    Next
End Sub

根据多个条件移动单元

2 个答案: