Question

下面我有一个程序将转到工作表（库存），查看员工姓名，列A，如果它与上面相同（上次）

If Cells(i & ",1").Value = Cells(i - 1 & ",1").Value Then

然后查看B列中的描述，如果不是我需要的描述，请转到下一行并重复。如果这是我需要的，那么将行复制回到表J并复制到那里。冲洗泡沫重复。但是目前它正在做的是为i添加另一个值并继续前进，这意味着它只是跳过每一行。我需要添加什么循环才能重新检查下一行，即i = 3同样的东西，也可能丢弃它？

对于奖励积分，A列扫描不起作用。对此的帮助会很棒。

Dim i As Integer
Dim j As Integer
Dim k As Integer

i = 2
j = 73
k = 3

ActiveCell.FormulaR1C1 = "Inventory"
Sheets("Inventory").Select
Do Until i = 4495
   If Cells(i & ",1").Value = Cells(i - 1 & ",1").Value Then
       Sheets("Inventory").Select
       Application.ScreenUpdating = False
       If Cells(i & ",2").Text <> "CONSUMABLES" _
           Or Cells(i & ",2").Text <> "FILTERS - BILLI TRIO" _
           Or Cells(i & ",2").Text <> "FILTERS - ZIP GENERIC" _
           Or Cells(i & ",2").Text <> "GOODS" _
           Or Cells(i & ",2").Text <> "HARDWARE FIXINGS" _
           Or Cells(i & ",2").Text <> "LIGHTING - 50W DICHROIC" _
           Or Cells(i & ",2").Text <> "LIGHTING - COMPACT BC/ES" _
           Or Cells(i & ",2").Text <> "LIGHTING - DICHROIC LAMP" _
           Or Cells(i & ",2").Text <> "LIGHTING - FLURO" _
           Or Cells(i & ",2").Text <> "LIGHTING - PLC LAMP 840/830" _
           Or Cells(i & ",2").Text <> "LIGHTING - PL-L" _
           Or Cells(i & ",2").Text <> "LIGHTING - PULSE STARTER" _
           Or Cells(i & ",2").Text <> "LIGHTING - STANDARD STARTER" _
           Or Cells(i & ",2").Text <> "LIGHTING - T5 FLURO" _
           Or Cells(i & ",2").Text <> "NITROGEN CHARGE" _
           Or Cells(i & ",2").Text <> "OXYGEN / ACETYLENE WELDING" _
           Or Cells(i & ",2").Text <> "R-134A" _
           Or Cells(i & ",2").Text <> "R-22" _
           Or Cells(i & ",2").Text <> "R-407C" _
           Or Cells(i & ",2").Text <> "R-410A" = 0 Then   
               i = i + 1
       Exit If
   Rows(i).Select
   Selection.Copy
   Sheets("Sheet" & j).Select
   Rows(k).Select
   ActiveSheet.Paste
   i = i + 1
   k = k + 1
Else

Answer 1

试试这个：

Option Explicit

Sub Sample()

Dim myarray
Dim wsInv As Worksheet
Dim rngDes As Range, rng As Range, cel As Range
Dim k As Long

Set wsInv = Thisworkbook.Sheets("Inventory")

'~~>Assign all cell in Column A with value
Set rng = wsInv.Range("A2", wsInv.Range("A" & Rows.Count).End(xlup).Address)

'~~> you identified j = 73 so I assign it directly
Set rngDes = Thisworkbook.Sheets("Sheet73").Range("A3")

'~~> assign all the compare values in an array
myarray = Array("CONSUMABLES", "FILTERS - BILLI TRIO", "FILTERS - ZIP GENERIC", _
    "GOODS", "HARDWARE FIXINGS", "LIGHTING - 50W DICHROIC", "LIGHTING - COMPACT BC/ES", _
    "LIGHTING - DICHROIC LAMP", "LIGHTING - FLURO", "LIGHTING - PLC LAMP 840/830", _
    "LIGHTING - PL-L", "LIGHTING - PULSE STARTER", "LIGHTING - STANDARD STARTER", _
    "LIGHTING - T5 FLURO", "NITROGEN CHARGE", "OXYGEN / ACETYLENE WELDING", _
    "R-134A", "R-22", "R-407C", "R-410A")

'~~> Initialize k to 0 to used in offet
k = 0
For Each cel in rng
    If cel.Value = cel.Offset(-1,0).Value Then
        If Not IsError(Application.Match(cel.Offset(0,1).value, myarray, 0)) Then  
            cel.EntireRow.Copy rngDes.Offset(k,0)
            k = k + 1
        End If
    End If
Next cel

End Sub

如果存在连续值，则上述操作检查库存表A列中的每个值如果有，我检查它的相邻单元格（B列）是否在myarray范围内如果是，那么它会将整行复制到Sheet73 这是你需要的吗？

Excel宏扫描单元格以获取多个值。和循环

1 个答案: