Question

我正在尝试浏览用户在列表框中选择的数据，当用户单击“保留下脚料”时，然后将我复制到工作表“下脚料篮”上的所有选定数据行放置到被标记为“ wo2”的数据库工作表，我希望我的代码然后查看E列的每一行，如果该ID与数据库工作表上的ID匹配，则它将输入值“ Snumber”，这是捕获的值在ID旁边列的用户窗体上的文本框中输入

我的问题是我遍历每个单元格的代码正在请求一个对象，我看到我需要声明这些对象，这意味着我需要遍历哪张纸，但是只是更好地了解了我将其放置在何处循环将有很大的帮助。谢谢大家

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

Answer 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:\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

循环遍历工作表a中的每个单元格，如果工作表B中的值true，则用“保留”替换单元格值

1 个答案: