Перебирать каждую ячейку на листе a и, если значение true, на листе B, чтобы заменить значение ячейки на «зарезервировано»

#vba

#vba

Вопрос:

Я пытаюсь просмотреть данные, которые пользователь выбрал в списке, когда пользователь нажимает «Зарезервировать вырезы», тогда все выбранные строки данных, которые я скопировал на листе «Корзина вырезов», затем помещаются на лист базы данных, который помечен как «wo2». Я хочу, чтобы мой кодзатем просмотреть каждую строку столбца E и, если этот идентификатор совпадает с идентификатором на листе базы данных, затем будет введено значение как «Snumber», которое является значением, которое записывается из текстового поля в пользовательской форме в столбце рядом с идентификатором

моя проблема в том, что мой код, который просматривает каждую ячейку, запрашивает объект, я вижу, что мне нужно объявить объекты, означающие, на каком листе мне нужно просмотреть, но просто лучшее понимание того, куда я поместил свой цикл, будет большим подспорьем. Спасибо всем

 Private Sub CommandButton11_Click()

'Reserve offcuts with job number

If Offcut11.OffcutJob.Value = "" Then
MsgBox "Please insert SAGE job number!", vbExclamation, "JDS"
Exit Sub
End If

Dim snumber As String

snumber = Offcut11.OffcutJob.Value

Dim wo1 As Workbook
Dim wo2 As Workbook

Set wo1 = Workbooks("Fabrication Schedule v2")

Do

Set wo2 = Workbooks.Open(Filename:="J:DatabaseOffcut Database.xlsx")
If wo2.ReadOnly Then Application.Wait Now   TimeSerial(0, 0, 1)
Loop Until Not wo2.ReadOnly

Application.Visible = False
Application.ScreenUpdating = False

wo1.Activate
Sheets("Offcut Basket").Activate
Range("A2:F200").Copy

wo2.Activate
Sheets("Offcut Basket").Activate
Range("A1").PasteSpecial xlPasteValues

Dim acr As String

Dim v As Range
Set v = Worksheets("Offcut Basket").Cells(Worksheets("Offcut Basket").Rows.Count, "E").End(xlUp)
With Worksheets("Offcut Database")
    For Each cell In .Range(.Cells(2, "E"), .Cells(.Rows.Count, "E").End(xlUp))
        If Int(cell.Value2) = Int(r.Value2) Then
            Cells(v.Row, 2).Select
            acr = ActiveCell.Row
            Cells(acr, "F").Value = snumber
        End If
    Next cell
End With

Application.DisplayAlerts = False
wo2.Save
wo2.Close
wo1.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Offcuts have been reserved", vbExclamation, "JDS"

End Sub
 

Комментарии:

1. «r», похоже, не определено> Int(r.Value2) < Добавить параметр явно вверху перед закрытым

2. Спасибо. Я попробую завтра утром и вставлю исправленный код, если он работает.

3. @donpablo заработало, спасибо

Ответ №1:

Я понял это,

 Private Sub CommandButton11_Click()

'Reserve offcuts with job number

If Offcut11.OffcutJob.Value = "" Then
MsgBox "Please insert SAGE job number!", vbExclamation, "JDS"
Exit Sub
End If

Dim snumber As String

snumber = Offcut11.OffcutJob.Value

Dim wo1 As Workbook
Dim wo2 As Workbook

Set wo1 = Workbooks("Fabrication Schedule v2")

Do

Set wo2 = Workbooks.Open(Filename:="J:DatabaseOffcut Database.xlsx")
If wo2.ReadOnly Then Application.Wait Now   TimeSerial(0, 0, 1)
Loop Until Not wo2.ReadOnly

Application.Visible = False
Application.ScreenUpdating = False

wo1.Activate
Sheets("Offcut Basket").Activate
Range("A2:F200").Copy

wo2.Activate
Sheets("Offcut Basket").Activate
Range("A1").PasteSpecial xlPasteValues

Dim acr As String

Dim v As Range
Dim Found As Range

Set v = Sheets("Offcut Basket").Range("E1", Range("E" amp; Rows.Count).End(xlUp))

For Each cell In v

Sheets("Offcut Database").Activate
Set Found = Sheets("Offcut Database").Range("A2", Range("E" amp; Rows.Count).End(xlUp)).Find(cell, LookAt:=xlWhole)
Cells(Found.Row, 2).Select
acr = ActiveCell.Row

Cells(acr, "F").Value = snumber

Next cell

Application.DisplayAlerts = False
wo2.Save
wo2.Close
wo1.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Offcuts have been reserved", vbExclamation, "JDS"

End Sub