Question

enter image description here [在此处输入图片说明] [2]嗨，

我有一个问题，希望有人可以提供帮助。我有一个Excel工作表，我需要检查是否从上一行开始，如果上一行中存在与上一行第4列相同的值，但条件是，仅当第1列和第2列相同而不是第3列时单词“SK”或“SV”，然后我需要对第7列中的值求和，并将第3列和第6列连接起来，只需保留一行，另一行作为此计算的基础必须删除。

附上你会找到截图。首先说明Excel文件在处理之前的样子以及下一个屏幕截图之后的样子。

enter image description here

Answer 1

以下是代码：

Sub combine_data()

    Dim vLastRow As Integer
    Dim Col_A_Str As String
    Dim Col_B_Str As String
    Dim r As Integer
    Dim vDatarow As Integer
    Dim vCodeStr3 As String
    Dim vCodeStr6 As String
    Dim vTotal As Double
    Dim Col_D_Str As String

    vLastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    Col_A_Str = ""
    Col_B_Str = ""
    r = 1
    vDatarow = 0
    vCodeStr3 = ""
    vCodeStr6 = ""
    vTotal = 0
    Col_D_Str = ""

    Col_A_Str = Trim(Cells(vLastRow, 1))
    Col_B_Str = Trim(Cells(vLastRow, 2))
    Col_D_Str = Trim(Cells(vLastRow, 4))

    Do Until r = vLastRow

        DoEvents

        If Trim(Cells(r, 4)) = Col_D_Str Then

            If Trim(Cells(r, 1)) = Col_A_Str Then

                If Trim(Cells(r, 2)) = Col_B_Str Then

                    If UCase(Trim(Cells(r, 3))) <> "SV" And UCase(Trim(Cells(r, 3))) <> "SK" Then

                        If vDatarow = 0 Then

                            If vDatarow = 0 Then vDatarow = r

                            vCodeStr3 = Trim(Cells(r, 3))
                            vCodeStr6 = Trim(Cells(r, 6))
                            vTotal = Cells(r, 7)

                            r = r + 1

                        Else

                            vCodeStr3 = vCodeStr3 & ", " & Trim(Cells(r, 3))
                            vCodeStr6 = vCodeStr6 & ", " & Trim(Cells(r, 6))
                            vTotal = vTotal + Cells(r, 7)

                            Cells(r, 1).EntireRow.Delete
                            vLastRow = vLastRow - 1

                        End If

                    Else

                        r = r + 1

                    End If

                Else

                     r = r + 1

                End If

            Else

                 r = r + 1

            End If

         Else

            r = r + 1

        End If

    Loop

    Cells(vDatarow, 3).ClearContents
    Cells(vDatarow, 3) = vCodeStr3

    Cells(vDatarow, 6).ClearContents
    Cells(vDatarow, 6) = vCodeStr6

    Cells(vDatarow, 7).ClearContents
    Cells(vDatarow, 7) = vTotal

End Sub

EXCEL VBA查找值然后求和然后删除其他行

1 个答案: