Если тогда еще, тогда неправильное утверждение Excel VBA - PullRequest
0 голосов
/ 29 января 2020

Можете ли вы помочь мне, пожалуйста. У меня есть код ниже, если у меня есть только если операторы без else if, код работает нормально, но если я пишу elseif case, то ничего не работает правильно. Например, если я набираю продукт, который находится на листе каталога, и я хочу изменить его, он показывает, что продукта не существует, и если я пытаюсь добавить тот же продукт, в который он входит. Кроме этого окна сообщений отображаются 2 раза. Например, если я добавляю новый товар, он показывает 2 раза "Хотите добавить товар?" но продукт добавил только 1.

Dim t1, t2, t3, t4
Dim arrayData As Variant
Dim arrayData2 As Variant
Dim cleanData As Range
Dim keli As Range
Dim baseSheet As Object
Dim formaSheet As Object
Dim Stock As Object
Dim meter As Long
Dim meter2 As Long
Dim Movement As String
Dim i As Integer


    Set Stock = Sheets("StockMovements")
    Set baseSheet = Sheets("Catalogue")
    Set formaSheet = Sheets("DataEntry")
    Set t1 = formaSheet.Range("A6")
    Set t2 = formaSheet.Range("B6")
    Set t3 = formaSheet.Range("C6")
    Set t4 = formaSheet.Range("D6")

    Movement = Range("E6").Value

 If Movement Like "ADD NEW" Then

 For i = 2 To 10000


    With Worksheets("DataEntry")
    If (UCase(Trim(Worksheets("DataEntry").Cells(6, "A"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "B")))) _
    Then
       MsgBox "The product already exists. Try to change it", vbOKCancel
    ElseIf (UCase(Trim(Worksheets("DataEntry").Cells(6, "A"))) <> UCase(Trim(Worksheets("Catalogue").Cells(i, "B")))) _
    Then
             MsgBox "Do you wnat to add new product?", vbOKCancel
             meter = Application.WorksheetFunction.CountA(baseSheet.Range("A:A"))
             meter2 = Application.WorksheetFunction.CountA(Stock.Range("A:A"))
             arrayData = VBA.Array(t1, t2, t3, t4)
             Set cleanData = Union(t1, t2, t3)

             With cleanData.Cells
              Set keli = .Find(What:="*", LookIn:=xlValues)
              If keli Is Nothing Then
              GoTo telos
              End If
             End With

             baseSheet.Cells(meter + 1, 2).Resize(, 4) = arrayData
             Stock.Cells(meter2 + 1, 2).Resize(, 4) = arrayData
             cleanData.ClearContents
    End If


End With
Next i

End If



If Movement Like "CHANGE" Then

 For i = 2 To 10000


    With Worksheets("DataEntry")
    If (UCase(Trim(Worksheets("DataEntry").Cells(6, "A"))) = UCase(Trim(Worksheets("Catalogue").Cells(i, "B")))) _
    Then
         Worksheets("Catalogue").Cells(i, "B") = Worksheets("DataEntry").Cells(6, "A")
         Worksheets("Catalogue").Cells(i, "C") = Worksheets("DataEntry").Cells(6, "B")
         Worksheets("Catalogue").Cells(i, "D") = Worksheets("DataEntry").Cells(6, "C")
         Worksheets("Catalogue").Cells(i, "E") = Worksheets("DataEntry").Cells(6, "D")

         Worksheets("StockMovements").Cells(i, "C") = Worksheets("DataEntry").Cells(6, "B")
         Worksheets("StockMovements").Cells(i, "D") = Worksheets("DataEntry").Cells(6, "C")
         Worksheets("StockMovements").Cells(i, "E") = Worksheets("DataEntry").Cells(6, "D")
    ElseIf (UCase(Trim(Worksheets("DataEntry").Cells(6, "A"))) <> UCase(Trim(Worksheets("Catalogue").Cells(i, "B")))) _
    Then
        MsgBox "The product does not exist. Select add new and then continue", vbOKCancel

    End If
End With
Next i
Set cleanData = Union(t1, t2, t3)

With cleanData.Cells
 Set keli = .Find(What:="*", LookIn:=xlValues)
 If keli Is Nothing Then GoTo telos
 End With

cleanData.ClearContents
End If

telos:

End Sub




enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...