Выполните цикл по каждой ячейке в листе a, и если значение true в листе B, чтобы заменить значение ячейки на «зарезервированное» - PullRequest
0 голосов
/ 19 апреля 2019

Я пытаюсь просмотреть данные, которые пользователь выбрал в списке, когда пользователь нажимает «Резервировать отрывки», тогда все выбранные строки данных, которые я скопировал на листе «Вырезанная корзина», затем помещаются на лист базы данных, который обозначен как "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:\Database\Offcut 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 Ответ

0 голосов
/ 22 апреля 2019

Я понял,

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:\Database\Offcut 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" & Rows.Count).End(xlUp))

For Each cell In v

Sheets("Offcut Database").Activate
Set Found = Sheets("Offcut Database").Range("A2", Range("E" & 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...