0

我正在研究下面的一段代码，并让它正常运行。不知何故，一条线发生了变化，这意味着它现在无法运行

我有一个标签和权重表，如下所示：

Tag   | Weight
---------------
Sport |  1
Music |  1

然后是另一个用户表，带有标签+权重

User  |  Tag   |  Weight

单元格（j，“B”）包含用户名，就像另一个工作表中的单元格（2，“C”）一样

我正在使用以下代码：

Sub swipeleft()

LastRowUser = Worksheets(13).Range("B65536").End(xlUp).Row
LastRowInput = Worksheets(14).Range("F65536").End(xlUp).Row
LastRowUser = LastRowUser + 1

newcount = 1

For j = 2 To LastRowUser
    For k = 9 To LastRowInput
        If Worksheets(14).Cells(k, "F") = Worksheets(13).Cells(j, "C") And Worksheets(13).Cells(j, "B") = Worksheets(14).Cells(2, "C") Then
            Worksheets(13).Cells(j, "D") = Worksheets(13).Cells(j, "D") - Worksheets(14).Cells(k, "G")
        ElseIf Not Worksheets(13).Cells(j, "B") = Worksheets(14).Cells(2, "C") Then
            Worksheets(13).Cells(newcount + LastRowUser, "C") = Worksheets(14).Cells(k, "F")
            Worksheets(13).Cells(newcount + LastRowUser, "D") = Worksheets(14).Cells(k, "G") * (-1)
            Worksheets(13).Cells(newcount + LastRowUser, "B") = Worksheets(14).Cells(2, "C")
            newcount = newcount + 1
        End If
    Next k
Next j

End Sub

当数据不存在时，这会添加行，但由于某种原因，在第一次运行后它会继续以指数方式添加更多行，即使不满足第二个 else 条件？

根据以下评论更新

这是用户输入页面（工作表 14）：

在此处输入图像描述

这是用户数据库页面（工作表 13）：

在此处输入图像描述

在用户数据库页面上，我希望它添加不存在的两行（音乐、舞蹈）并将输入页面中的运动标签权重（-1）添加到用户数据库页面中的当前值

4

1 回答 1

0

这是你想要的吗？

代码：

Dim AR
Dim nWeight As Long
Dim wsI As Worksheet, wsO As Worksheet
Dim LRowWsI As Long, LRowWsO As Long, NewRowWsO As Long

Sub swipeleft()
    Dim i As Long, j As Long

    Set wsI = ThisWorkbook.Sheets(14)
    Set wsO = ThisWorkbook.Sheets(13)

    LRowWsI = wsI.Range("F" & wsI.Rows.Count).End(xlUp).Row

    LRowWsO = wsO.Range("B" & wsI.Rows.Count).End(xlUp).Row
    NewRowWsO = LRowWsO + 1

    AR = wsI.Range("F9:G" & LRowWsI).Value

    With wsO
        For i = LBound(AR) To UBound(AR)
            For j = 2 To LRowWsO
                If RecordExists(wsI.Range("C2").Value, AR(i, 1)) Then
                    .Range("D" & j).Value = AR(i, 2)
                Else
                    .Range("B" & NewRowWsO).Value = wsI.Range("C2").Value
                    .Range("C" & NewRowWsO).Value = AR(i, 1)
                    .Range("D" & NewRowWsO).Value = AR(i, 2)
                    NewRowWsO = NewRowWsO + 1
                End If
            Next j
        Next i
    End With
End Sub

Function RecordExists(sUser As Variant, sTag As Variant) As Boolean
    Dim a As Long

    With wsO
        For a = 2 To LRowWsO
            If .Range("B" & a).Value = sUser And .Range("C" & a).Value = sTag Then
                RecordExists = True
                Exit For
            End If
        Next
    End With
End Function

截屏：

在此处输入图像描述

于 2013-10-24T09:31:11.627 回答