VBA在不可能寫入多餘行的時候寫下

我在下面的一段代碼上寫了一段代碼，並使它正常工作。不知怎的線已經改變，意味着現在不能進行正常VBA在不可能寫入多餘行的時候寫下

我的標籤和權重的表像這樣：

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條件沒有得到滿足？

修訂FROM COMMENTS BELOW

這裏是用戶輸入頁面（工作表14）：

enter image description here

這裏是用戶數據庫頁（工作表13）：

enter image description here

在用戶數據庫頁面上，我希望它添加不存在的兩行（音樂，舞蹈），並將體育標籤權重（-1）從輸入頁面添加到用戶數據庫頁面中的當前值

來源

2013-10-24 dojogeorge

什麼是你到底想幹什麼？ –

在單元格中（2，「C」）我輸入了我的用戶名'darnich'。當我運行這個宏時，我希望它找到標籤已經存在的地方，在這種情況下，它會將權重添加到當前的USER | TAG | WEIGHT表中。如果它沒有在表格中找到（名稱&&標籤）（即，如果該用戶具有該標籤的記錄不存在於USER | TAG | WEIGHT表格中的任何地方），那麼在該表格中創建新記錄 – dojogeorge

對不起，我仍然無法想象你的問題。你說你在ColC中輸入用戶名。但是根據你的表格，Col C有「Weight」，或者你的表從Col C開始？也許數據的屏幕截圖可能有幫助？ –

這你想要什麼？

代碼：

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

截圖：

enter image description here

來源

2013-10-24 09:31:11

如果我不止一次運行該數據，數據會在表13中重複出現，因此我得到數百行相同的數據，但我希望它只是更新匹配的記錄。 – dojogeorge

能有更多的用戶嗎？ –

是的工作表14中的單元格C2可以包含任何名稱，可能存在或可能不存在於工作表13 – dojogeorge

VBA在不可能寫入多餘行的時候寫下

回答

相關問題