excel 不基于空单元格复制行

oknwwptz  于 2023-10-22  发布在  其他
关注(0)|答案(2)|浏览(150)

我有一个代码,它从表1中获取具有特定值(TI 002768 E2 XA E005)的单元格(E列),并将这些选定的单元格(在B-F列和可变行中)移动到表2。这些单元格有时会有空白值(通常是D列和F列),这些值会传递到Sheet 2,但我不希望有空白单元格的行。如何避免将包含空白单元格的行从工作表1移动到工作表2?感谢您的任何帮助!

Sub SAPDashboard()

Dim LastRow As Long
Dim myRow As Long
Dim myCopyRow As Long
Dim LastRow1 As Long
      
myCopyRow = 3

LastRow = Sheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Row

Application.ScreenUpdating = False

For myRow = 1 To LastRow

    If Sheets("Sheet1").Cells(myRow, "E") = "TI002768E2XA E005" Then
        Sheets("Sheet2").Cells(myCopyRow, "B") = Sheets("Sheet1").Cells(myRow, "e")
        Sheets("Sheet2").Cells(myCopyRow, "C") = Sheets("Sheet1").Cells(myRow, "d")
        Sheets("Sheet2").Cells(myCopyRow, "D") = Sheets("Sheet1").Cells(myRow, "F")
        Sheets("Sheet2").Cells(myCopyRow, "E") = Sheets("Sheet1").Cells(myRow, "G")
        Sheets("Sheet2").Cells(myCopyRow, "F") = Sheets("Sheet1").Cells(myRow, "H")

        myCopyRow = myCopyRow + 1
    
    End If
    
Next myRow

LastRow1 = Range("b5000").End(xlUp).Row
LastRow = Range("A5000").End(xlUp).Row
Range("E" & LastRow1 + 1).Formula = "=SUM(E3:E" & LastRow1 & ")"
Range("F" & LastRow1 + 1).Formula = "=SUM(F3:F" & LastRow1 & ")"

Columns("A:AB").HorizontalAlignment = xlCenter
Range("B2:F2").Value = Array("Charge Code", "Name", "Title", "Cost", "Hours")
Worksheets("Sheet2").Range("B2:F2").Font.Bold = True
Range("B2:F2").Interior.ColorIndex = 15
Range("B2:F2").EntireColumn.AutoFit
Range("E:E").Style = "Currency"

         
Set rng = Nothing
      
With Range("B2:F" & Range("B" & Rows.Count).End(xlUp).Row)
  .Borders.ColorIndex = 1
  .Borders.Weight = xlThin
  .BorderAround , xlThick, 1
  .Resize(1).Borders(xlEdgeBottom).Weight = xlThick

End With

End Sub
nszi6y05

nszi6y051#

使用COUNTA函数检查源表中的空白单元格

Dim srcRange As Range
For myRow = 1 To LastRow
    If Sheets("Sheet1").Cells(myRow, "E") = "TI002768E2XA E005" Then
        Set srcRange = Sheets("Sheet1").Cells(myRow, "d").Resize(1, 5)
        If NoEmpty(srcRange) Then
            Sheets("Sheet2").Cells(myCopyRow, "B") = Sheets("Sheet1").Cells(myRow, "e")
            Sheets("Sheet2").Cells(myCopyRow, "C") = Sheets("Sheet1").Cells(myRow, "d")
            Sheets("Sheet2").Cells(myCopyRow, "D") = Sheets("Sheet1").Cells(myRow, "F")
            Sheets("Sheet2").Cells(myCopyRow, "E") = Sheets("Sheet1").Cells(myRow, "G")
            Sheets("Sheet2").Cells(myCopyRow, "F") = Sheets("Sheet1").Cells(myRow, "H")
            myCopyRow = myCopyRow + 1
        End If
    End If
Next myRow


' UDF to validate the range
Function NoEmpty(dataRange As Range) As Boolean
    Dim c As Range
    For Each c In dataRange
        If Len(Trim(c.Value)) = 0 Then
            NoEmpty = False
            Exit Function
        End If
    Next
    NoEmpty = True
End Function
fdbelqdn

fdbelqdn2#

你就快成功了。只需再插入一个if条件,检查Sheet1中的任何空单元格。就像下面的代码。我把“noEmptyCells”函数,返回布尔检查后列“D”和“F”。如果你想检查其他列,只需在noEmptyCells函数中的Array中添加列字母。:)

If (Sheets("Sheet1").Cells(myRow, "E") = "TI002768E2XA E005") Then
    If noEmptyCells(myRow) Then
        Sheets("Sheet2").Cells(myCopyRow, "B") = Sheets("Sheet1").Cells(myRow, "e")
        Sheets("Sheet2").Cells(myCopyRow, "C") = Sheets("Sheet1").Cells(myRow, "d")
        Sheets("Sheet2").Cells(myCopyRow, "D") = Sheets("Sheet1").Cells(myRow, "F")
        Sheets("Sheet2").Cells(myCopyRow, "E") = Sheets("Sheet1").Cells(myRow, "G")
        Sheets("Sheet2").Cells(myCopyRow, "F") = Sheets("Sheet1").Cells(myRow, "H")

        myCopyRow = myCopyRow + 1
    End If
End If

Function noEmptyCells(myRow As Long) As Boolean
  Dim c As Variant
  Dim v As Boolean, v_sum As Boolean
  v_sum = True
  For Each c In Array("D", "F")
    v = Not IsEmpty(Sheets("Sheet1").Cells(myRow, c))
    v_sum = v_sum * v
  Next c
  noEmptyCells = v_sum
End Function

相关问题