Добрый вечер, подскажите пожалуйста, как нужно исправить код чтобы заполнялись все ячейки?
На листе "РЕЕСТР ПРОДАЖ" после оплаты в столбце "J" должна считаться разница цен, считается только одна такая строка.
Часть кода которая отвечает за заполнение начинается с "For W = 3 to ...."
Файл прилогаю
Если кто знает как исправить буду благодарен
| Код |
|---|
Sub SubtractAllQuantities()
Dim sheet1 As Worksheet: Set sheet1 = ThisWorkbook.Sheets("КАРТОЧКА ТОВАРА")
Dim sheet2 As Worksheet: Set sheet2 = ThisWorkbook.Sheets("СИСТЕМА")
Dim sheet3 As Worksheet: Set sheet3 = ThisWorkbook.Sheets("РЕЕСТР ПРОДАЖ")
Dim lastRow1 As Long
Dim rng As Range, X As Long
lastRow1 = sheet1.Cells(Rows.Count, "A").End(xlUp).Row
Dim lastRow2 As Long
lastRow2 = sheet2.Cells(Rows.Count, "A").End(xlUp).Row
Dim lastRow3 As Long
lastRow3 = sheet3.Cells(Rows.Count, "E").End(xlUp).Row
Dim I As Long, J As Long, W As Long, Y As Long
Application.ScreenUpdating = False
' пройти по каждому ID номеру на втором листе
For I = 2 To lastRow2
' пройти по каждому ID номеру на первом листе
For J = 3 To lastRow1
' если ID номера совпадают, вычесть количество на втором листе из количества на первом листе
If sheet1.Cells(J, "A").Value = sheet2.Cells(I, "A").Value And sheet2.Cells(I, "E").Value < sheet1.Cells(J, "D").Value And sheet2.Cells(I, "c").Value = sheet1.Cells(J, "H").Value Then
sheet1.Cells(J, "C").Value = sheet1.Cells(J, "C").Value - sheet2.Cells(I, "D").Value * sheet1.Cells(J, "E").Value
Else
If sheet1.Cells(J, "A").Value = sheet2.Cells(I, "A").Value Then
sheet1.Cells(J, "C").Value = sheet1.Cells(J, "C").Value - sheet2.Cells(I, "D").Value
If sheet1.Cells(J, "C").Value <> 0.001 Then
sheet1.Cells(J, "C").Value = "0"
End If
Exit For
End If
End If
Next J
Next I
For X = 3 To lastRow1
If sheet1.Cells(X, "C").Value < 0.001 Then
sheet1.Cells(X, "C").Value = "0"
End If
Next X
For W = 3 To lastRow1
For Y = 4 To lastRow3
If sheet1.Cells(W, "A").Value = sheet3.Cells(Y, "E").Value Then
sheet3.Cells(Y, "J").Value = (sheet1.Cells(W, "D").Value - sheet1.Cells(W, "I").Value) * sheet3.Cells(Y, "G").Value
Exit For
End If
Next Y
Next W
Application.ScreenUpdating = True
End Sub
|
